diff options
460 files changed, 10315 insertions, 10491 deletions
diff --git a/.gitignore b/.gitignore index 014970f96b2..d4be6bb23eb 100644 --- a/.gitignore +++ b/.gitignore @@ -135,6 +135,7 @@ src/gl-stamp *.o *.res *.so +*.dylib core core.*[0-9] gmon.out @@ -214,42 +214,6 @@ like 'apt-get build-dep emacs' (on older systems, replace 'emacs' with eg 'emacs25'). On Red Hat-based systems, the corresponding command is 'dnf builddep emacs' (on older systems, use 'yum-builddep' instead). -* GNU/Linux source and debug packages - -Many GNU/Linux systems provide separate packages containing the -sources and debug symbols of Emacs. They are useful if you want to -check the source code of Emacs primitive functions or debug Emacs on -the C level. - -The names of the packages that you need vary according to the -GNU/Linux distribution that you use. On Debian-based systems, you can -install a source package of Emacs with a command like 'apt-get source -emacs' (on older systems, replace 'emacs' with eg 'emacs25'). The -target directory for unpacking the source tree is the current -directory. On Red Hat-based systems, the corresponding command is -'dnf install emacs-debugsource', with target directory /usr/src/debug -(this requires to add the *-debuginfo repositories first, via 'dnf -config-manager --set-enabled fedora-debuginfo updates-debuginfo'). - -Once you have installed the source package, for example at -/path/to/emacs-26.1, add the following line to your startup file: - - (setq find-function-C-source-directory - "/path/to/emacs-26.1/src") - -The installation directory of the Emacs source package will contain -the exact package name and version number Emacs is installed on your -system. If a new Emacs package is installed, the source package must -be reinstalled as well, and the setting in your startup file must be -updated. - -Emacs debugging symbols are distributed by a debug package. It does -not exist for every released Emacs package, this depends on the -distribution. On Debian-based systems, you can install a debug -package of Emacs with a command like 'apt-get install emacs-dbg' (on -older systems, replace 'emacs' with eg 'emacs25'). On Red Hat-based -systems, the corresponding command is 'dnf debuginfo-install emacs'. - DETAILED BUILDING AND INSTALLATION: @@ -2,7 +2,7 @@ Copyright (C) 2001-2020 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 27.0.60 of GNU Emacs, the extensible, +This directory tree holds version 28.0.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index ea99d50094f..ce9a44436d8 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -201,7 +201,6 @@ HAVE_LIBXML2 HAVE_LIBXMU HAVE_LOCALTIME_R HAVE_LOCAL_SOCKETS -HAVE_LONG_LONG_INT HAVE_LRAND48 HAVE_LSTAT HAVE_LUTIMES @@ -322,7 +321,6 @@ HAVE_TM_ZONE HAVE_TOUCHLOCK HAVE_TZNAME HAVE_TZSET -HAVE_UNSIGNED_LONG_LONG_INT HAVE_UTIL_H HAVE_UTIMENSAT HAVE_UTIMES diff --git a/admin/gitmerge.el b/admin/gitmerge.el index eeef4e3fc59..922ddef6bbd 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -52,7 +52,7 @@ ;; caused false positives. --Stef (let ((skip "back[- ]?port\\|cherry picked from commit\\|\ \\(do\\( no\\|n['’]\\)t\\|no need to\\) merge\\|not to be merged\\|\ -bump \\(Emacs \\)?version\\|Auto-commit")) +bump Emacs version\\|Auto-commit")) (if noninteractive skip ;; "Regenerate" is quite prone to false positives. ;; We only want to skip merging things like AUTHORS and ldefs-boot. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 3dee0b72b32..48c81e61e2a 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -38,7 +38,7 @@ GNULIB_MODULES=' getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ieee754-h ignore-value intprops largefile lstat manywarnings memmem-simple mempcpy memrchr minmax mkostemp mktime nstrftime - pathmax pipe2 pselect pthread_sigmask putenv + pathmax pipe2 pselect pthread_sigmask qcopy-acl readlink readlinkat regex sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strnlen strtoimax symlink sys_stat sys_time diff --git a/admin/notes/unicode b/admin/notes/unicode index 6cb1b764c51..1e418590a68 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -256,11 +256,19 @@ nontrivial changes to the build process. etc/tutorials/TUTORIAL.ja + * iso-2022-7bit + + This file contains multiple Chinese charsets, and converting it + to UTF-8 would lose the charset property and would change the + code's behavior. Although this could be worked around by + propertizing the strings, that hasn't been done. + + lisp/international/titdic-cnv.el + * utf-8-emacs These files contain characters that cannot be encoded in UTF-8. - lisp/international/titdic-cnv.el lisp/language/ethio-util.el lisp/language/ethiopic.el lisp/language/ind-util.el diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py index f206ff3da2f..9d19fe079a5 100755 --- a/admin/nt/dist-build/build-dep-zips.py +++ b/admin/nt/dist-build/build-dep-zips.py @@ -26,7 +26,7 @@ import re from subprocess import check_output ## Constants -EMACS_MAJOR_VERSION="27" +EMACS_MAJOR_VERSION="28" # This list derives from the features we want Emacs to compile with. PKG_REQ='''mingw-w64-x86_64-giflib diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 71959d633c5..73453cb9e47 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -1,4 +1,4 @@ -;; unidata-gen.el -- Create files containing character property data. +;; unidata-gen.el -- Create files containing character property data -*- lexical-binding:t -*- ;; Copyright (C) 2008-2020 Free Software Foundation, Inc. @@ -349,13 +349,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (n o c))))) ;; Functions to access the above data. -(defsubst unidata-prop-prop (proplist) (nth 0 proplist)) -(defsubst unidata-prop-index (proplist) (nth 1 proplist)) -(defsubst unidata-prop-generator (proplist) (nth 2 proplist)) -(defsubst unidata-prop-docstring (proplist) (nth 3 proplist)) -(defsubst unidata-prop-describer (proplist) (nth 4 proplist)) -(defsubst unidata-prop-default (proplist) (nth 5 proplist)) -(defsubst unidata-prop-val-list (proplist) (nth 6 proplist)) +(cl-defstruct (unidata-prop + (:type list) + (:constructor nil)) + prop index generator docstring describer default val-list) ;; SIMPLE TABLE @@ -383,11 +380,11 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ;; 3rd: 0 (corresponding to uniprop_encode_character in chartab.c) ;; 4th to 5th: nil -(defun unidata-gen-table-character (prop prop-idx &rest ignore) +(defun unidata-gen-table-character (prop prop-idx &rest _ignore) (let ((table (make-char-table 'char-code-property-table)) (vec (make-vector 128 0)) (tail unidata-list) - elt range val idx slot) + elt range val) (if (functionp prop-idx) (setq tail (funcall prop-idx) prop-idx 1)) @@ -395,9 +392,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (setq elt (car tail) tail (cdr tail)) (setq range (car elt) val (nth prop-idx elt)) - (if (= (length val) 0) - (setq val nil) - (setq val (string-to-number val 16))) + (setq val (if (= (length val) 0) + nil + (string-to-number val 16))) (if (consp range) (if val (set-char-table-range table range val)) @@ -419,8 +416,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (setq first-index last-index))) (setq tail (cdr tail))) (when first-index - (let ((str (string 1 first-index)) - c) + (let ((str (string 1 first-index))) (while (<= first-index last-index) (setq str (format "%s%c" str (or (aref vec first-index) 0)) first-index (1+ first-index))) @@ -502,7 +498,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ;; bidi.c:bidi_get_type and bidi.c:bidi_get_category. (bidi-warning "\ ** Found new bidi-class `%s', please update bidi.c and dispextern.h") - tail elt range val val-code idx slot + tail elt range val val-code prev-range-data) (setq val-list (cons nil (copy-sequence val-list))) (setq tail val-list val-code 0) @@ -510,9 +506,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (while tail (setcar tail (cons (car tail) val-code)) (setq tail (cdr tail) val-code (1+ val-code))) - (if (consp default-value) - (setq default-value (copy-sequence default-value)) - (setq default-value (list default-value))) + (setq default-value (if (consp default-value) + (copy-sequence default-value) + (list default-value))) (setcar default-value (unidata-encode-val val-list (car default-value))) (set-char-table-range table t (car default-value)) @@ -602,17 +598,17 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if (= count 128) (if val (set-char-table-range table (cons start limit) val-code)) - (if (= val-code 0) - (set-char-table-range table (cons start limit) str) - (if (> count 2) - (setq str (concat str (string val-code (+ count 128)))) - (if (= count 2) - (setq str (concat str (string val-code val-code))) - (setq str (concat str (string val-code))))) - (set-char-table-range table (cons start limit) str)))))) + (set-char-table-range table (cons start limit) + (if (= val-code 0) + str + (concat str (if (> count 2) + (string val-code (+ count 128)) + (if (= count 2) + (string val-code val-code) + (string val-code)))))))))) (set-char-table-extra-slot table 0 prop) - (set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list))) + (set-char-table-extra-slot table 4 (vconcat (mapcar #'car val-list))) table)) (defun unidata-gen-table-symbol (prop index default-value val-list) @@ -679,8 +675,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (let ((beg 0) (end 0) (len1 (length l1)) - (len2 (length l2)) - result) + (len2 (length l2))) (when (< len1 16) (while (and l1 (eq (car l1) (car l2))) (setq beg (1+ beg) @@ -688,13 +683,13 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (while (and (< end len1) (< end len2) (eq (nth (- len1 end 1) l1) (nth (- len2 end 1) l2))) (setq end (1+ end)))) - (if (= (+ beg end) 0) - (setq result (list -1)) - (setq result (list (+ (* beg 16) (+ beg (- len1 end)))))) - (while (< end len2) - (setcdr result (cons (nth (- len2 end 1) l2) (cdr result))) - (setq end (1+ end))) - result)) + (let ((result (list (if (= (+ beg end) 0) + -1 + (+ (* beg 16) (+ beg (- len1 end))))))) + (while (< end len2) + (push (nth (- len2 end 1) l2) (cdr result)) + (setq end (1+ end))) + result))) ;; Return a compressed form of the vector VEC. Each element of VEC is ;; a list of symbols of which names can be concatenated to form a @@ -703,7 +698,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ;; elements is usually small. (defun unidata-word-list-compress (vec) - (let (last-elt last-idx diff-head tail elt val) + (let (last-elt last-idx diff-head elt val) (dotimes (i 128) (setq elt (aref vec i)) (when elt @@ -768,7 +763,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (vec (make-vector 128 nil)) (idx 0) (case-fold-search nil) - c word-list tail-list last-list word diff-head) + c word-list tail-list last-list diff-head) (while (< i len) (setq c (aref val i)) (if (< c 3) @@ -784,7 +779,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (setq diff-head (prog1 (aref val i) (setq i (1+ i))))) (setq tail-list (nthcdr (% diff-head 16) last-list)) - (dotimes (i (/ diff-head 16)) + (dotimes (_ (/ diff-head 16)) (setq word-list (nconc word-list (list (car l))) l (cdr l)))))) (setq word-list @@ -808,7 +803,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (setcdr tail (cons elt (cdr tail))) (setcar tail " "))) (setq tail (cddr tail))) - (setq name (apply 'concat name)))) + (setq name (apply #'concat name)))) (aset table c name) (if (= c char) (setq val name)))) @@ -872,7 +867,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (vec (make-vector 128 nil)) (idx 0) (case-fold-search nil) - c word-list tail-list last-list word diff-head) + c word-list tail-list last-list diff-head) (while (< i len) (setq c (aref val i)) (if (< c 3) @@ -888,7 +883,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (setq diff-head (prog1 (aref val i) (setq i (1+ i))))) (setq tail-list (nthcdr (% diff-head 16) last-list)) - (dotimes (i (/ diff-head 16)) + (dotimes (_ (/ diff-head 16)) (setq word-list (nconc word-list (list (car l))) l (cdr l)))))) (setq word-list @@ -945,7 +940,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (word-list (list nil)) word-table block-list block-word-table block-end - tail elt range val idx slot) + tail elt range val idx) (setq tail unidata-list) (setq block-end -1) (while tail @@ -984,9 +979,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (push (list val range) block-list)))) (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) - (first tail) - (vec (make-vector 128 nil)) - c name len) + (vec (make-vector 128 nil))) (if (<= start block-end) ;; START overlap with the previous block. (aset table range (nth prop-idx elt)) @@ -1037,10 +1030,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (cdr (assq elt word-list)))) (setcar tail (string code)) (setq tail (cdr tail))) - (aset vec i (mapconcat 'identity (aref vec i) ""))))) + (aset vec i (mapconcat #'identity (aref vec i) ""))))) (set-char-table-range table (cons idx (+ idx 127)) - (mapconcat 'identity vec ""))))) + (mapconcat #'identity vec ""))))) (setq block-word-table (make-vector (length block-list) nil)) (setq idx 0) @@ -1086,19 +1079,18 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (or (byte-code-function-p (symbol-function fun)) (byte-compile fun)))) -(defun unidata-gen-table-name (prop index &rest ignore) +(defun unidata-gen-table-name (prop index &rest _ignore) (let* ((table (unidata-gen-table-word-list prop index 'unidata-split-name)) (word-tables (char-table-extra-slot table 4))) (unidata--ensure-compiled 'unidata-get-name 'unidata-put-name) (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-name)) (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-name)) - (if (eq prop 'name) - (set-char-table-extra-slot table 4 + (set-char-table-extra-slot table 4 + (if (eq prop 'name) (vector (car word-tables) (cdr word-tables) - unidata-name-jamo-name-table)) - (set-char-table-extra-slot table 4 + unidata-name-jamo-name-table) (vector (car word-tables)))) table)) @@ -1107,24 +1099,25 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." str (let ((len (length str)) (l nil) - (idx 0) - c) + (idx 0)) (if (= len 0) nil (dotimes (i len) - (setq c (aref str i)) - (if (= c 32) - (setq l (if (= (aref str idx) ?<) - (cons (intern (substring str (1+ idx) (1- i))) l) - (cons (string-to-number (substring str idx i) 16) l)) - idx (1+ i)))) - (if (= (aref str idx) ?<) - (setq l (cons (intern (substring str (1+ idx) (1- len))) l)) - (setq l (cons (string-to-number (substring str idx len) 16) l))) + (let ((c (aref str i))) + (when (= c ?\s) + (push (if (= (aref str idx) ?<) + (intern (substring str (1+ idx) (1- i))) + (string-to-number (substring str idx i) 16)) + l) + (setq idx (1+ i))))) + (push (if (= (aref str idx) ?<) + (intern (substring str (1+ idx) (1- len))) + (string-to-number (substring str idx len) 16)) + l) (nreverse l))))) -(defun unidata-gen-table-decomposition (prop index &rest ignore) +(defun unidata-gen-table-decomposition (prop index &rest _ignore) (let* ((table (unidata-gen-table-word-list prop index 'unidata-split-decomposition)) (word-tables (char-table-extra-slot table 4))) (unidata--ensure-compiled 'unidata-get-decomposition @@ -1167,7 +1160,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (forward-line))) result)) -(defun unidata-gen-table-special-casing (prop prop-idx &rest ignore) +(defun unidata-gen-table-special-casing (prop prop-idx &rest _ignore) (let ((table (make-char-table 'char-code-property-table))) (set-char-table-extra-slot table 0 prop) (mapc (lambda (entry) @@ -1175,7 +1168,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ;; If character maps to a single character, the mapping is already ;; covered by regular casing property. Don’t store those. (when (/= (length v) 1) - (set-char-table-range table ch (apply 'string v))))) + (set-char-table-range table ch (apply #'string v))))) (or unidata-gen-table-special-casing--cache (setq unidata-gen-table-special-casing--cache (unidata-gen-table-special-casing--do-load)))) @@ -1353,7 +1346,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ;; unidata-gen-table-special-casing--do-load and there is no other file ;; to compare those values with. This is why we’re skipping the check ;; for special casing properties. - (unless (eq generator 'unidata-gen-table-special-casing) + (unless (eq generator #'unidata-gen-table-special-casing) (setq table (progn (message "Generating %S table..." prop) (funcall generator prop index default-value val-list)) @@ -1369,19 +1362,21 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (and (stringp val1) (= (length val1) 0) (setq val1 nil)) - (if val1 - (cond ((eq generator 'unidata-gen-table-symbol) - (setq val1 (intern val1))) - ((eq generator 'unidata-gen-table-integer) - (setq val1 (string-to-number val1))) - ((eq generator 'unidata-gen-table-character) - (setq val1 (string-to-number val1 16))) - ((eq generator 'unidata-gen-table-decomposition) - (setq val1 (unidata-split-decomposition val1)))) - (cond ((eq prop 'decomposition) - (setq val1 (list char))) - ((eq prop 'bracket-type) - (setq val1 'n)))) + (setq val1 + (if val1 + (cond ((eq generator #'unidata-gen-table-symbol) + (intern val1)) + ((eq generator #'unidata-gen-table-integer) + (string-to-number val1)) + ((eq generator #'unidata-gen-table-character) + (string-to-number val1 16)) + ((eq generator #'unidata-gen-table-decomposition) + (unidata-split-decomposition val1)) + (t val1)) + (cond ((eq prop 'decomposition) + (list char)) + ((eq prop 'bracket-type) + 'n)))) (setq val2 (aref table char)) (when decoder (setq val2 (funcall decoder char val2 table))) diff --git a/build-aux/config.guess b/build-aux/config.guess index 4c8498faf3e..45001cfecde 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2020 Free Software Foundation, Inc. -timestamp='2019-09-10' +timestamp='2020-01-01' # 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 @@ -50,7 +50,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2019 Free Software Foundation, Inc. +Copyright 1992-2020 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." @@ -99,6 +99,8 @@ tmp= trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 : "${TMPDIR=/tmp}" # shellcheck disable=SC2039 { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || @@ -924,7 +926,7 @@ EOF echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" exit ;; alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null` in EV5) UNAME_MACHINE=alphaev5 ;; EV56) UNAME_MACHINE=alphaev56 ;; PCA56) UNAME_MACHINE=alphapca56 ;; diff --git a/build-aux/config.sub b/build-aux/config.sub index df031b3c853..f02d43ad500 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2020 Free Software Foundation, Inc. -timestamp='2019-06-30' +timestamp='2020-01-01' # 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 @@ -67,7 +67,7 @@ Report bugs and patches to <config-patches@gnu.org>." version="\ GNU config.sub ($timestamp) -Copyright 1992-2019 Free Software Foundation, Inc. +Copyright 1992-2020 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." diff --git a/configure.ac b/configure.ac index aa2d9ef745f..a4daf1414d3 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 27.0.60, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) +AC_INIT(GNU Emacs, 28.0.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. @@ -430,7 +430,7 @@ OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) -OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing]) +OPTION_DEFAULT_ON([cairo],[don't compile with Cairo drawing]) OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([json], [don't compile with native JSON support]) @@ -882,11 +882,6 @@ for func in $ac_func_list; do test $func = pthread_sigmask || AS_VAR_APPEND([funcs], [" $func"]) done ac_func_list=$funcs -# Use the system putenv even if it lacks GNU features, as we don't need them, -# and the gnulib replacement runs afoul of a FreeBSD 10.1 bug; see Bug#19874. -AC_CHECK_FUNCS_ONCE([putenv]) -AC_DEFUN([gl_FUNC_PUTENV], - [test "$ac_cv_func_putenv" = yes || REPLACE_PUTENV=1]) # Emacs does not use the wchar or wctype-h modules. AC_DEFUN([gt_TYPE_WINT_T], [GNULIB_OVERRIDES_WINT_T=0 @@ -1508,6 +1503,7 @@ case "$opsys" in UNEXEC_OBJ=unexelf.o ;; esac +AC_SUBST(UNEXEC_OBJ) LD_SWITCH_SYSTEM= test "$with_unexec" = no || case "$opsys" in @@ -1561,8 +1557,6 @@ C_SWITCH_MACHINE= test $with_unexec = yes && case $canonical in alpha*) - AC_CHECK_DECL([__ELF__]) - if test "$ac_cv_have_decl___ELF__" = "yes"; then ## With ELF, make sure that all common symbols get allocated to in the ## data section. Otherwise, the dump of temacs may miss variables in ## the shared library that have been initialized. For example, with @@ -1573,18 +1567,10 @@ case $canonical in else AC_MSG_ERROR([Non-GCC compilers are not supported.]) fi - else - dnl This was the unexalpha.c case. Removed in 24.1, 2010-07-24, - dnl albeit under the mistaken assumption that said file - dnl was no longer used. - AC_MSG_ERROR([Non-ELF systems are not supported since Emacs 24.1.]) - fi ;; esac AC_SUBST(C_SWITCH_MACHINE) -AC_SUBST(UNEXEC_OBJ) - C_SWITCH_SYSTEM= ## Some programs in src produce warnings saying certain subprograms ## are too complex and need a MAXMEM value greater than 2000 for @@ -2050,7 +2036,7 @@ NS_OBJ= NS_OBJC_OBJ= if test "${HAVE_NS}" = yes; then if test "$with_toolkit_scroll_bars" = "no"; then - AC_MSG_ERROR([Non-toolkit scroll bars are not implemented for Nextstep.]) + AC_MSG_WARN([Non-toolkit scroll bars are not implemented for Nextstep.]) fi window_system=nextstep @@ -3309,14 +3295,13 @@ if test "${HAVE_X11}" = "yes"; then EMACS_CHECK_MODULES(CAIRO, $CAIRO_MODULE) if test $HAVE_CAIRO = yes; then AC_DEFINE(USE_CAIRO, 1, [Define to 1 if using cairo.]) + CFLAGS="$CFLAGS $CAIRO_CFLAGS" + LIBS="$LIBS $CAIRO_LIBS" + AC_SUBST(CAIRO_CFLAGS) + AC_SUBST(CAIRO_LIBS) else - AC_MSG_ERROR([cairo requested but not found.]) + AC_MSG_WARN([cairo requested but not found.]) fi - - CFLAGS="$CFLAGS $CAIRO_CFLAGS" - LIBS="$LIBS $CAIRO_LIBS" - AC_SUBST(CAIRO_CFLAGS) - AC_SUBST(CAIRO_LIBS) fi fi @@ -3382,8 +3367,6 @@ if test "${HAVE_X11}" = "yes"; then fi # "$HAVE_XFT" != no fi # "x${with_xft}" != "xno" - ## We used to allow building with FreeType and without Xft. - ## However, the ftx font backend driver is not in good shape. if test "$HAVE_XFT" != "yes"; then dnl For the "Does Emacs use" message at the end. HAVE_XFT=no @@ -3676,8 +3659,13 @@ HAVE_MODULES=no MODULES_OBJ= case $opsys in cygwin|mingw32) MODULES_SUFFIX=".dll" ;; + darwin) MODULES_SUFFIX=".dylib" ;; *) MODULES_SUFFIX=".so" ;; esac +case "${opsys}" in + darwin) MODULES_SECONDARY_SUFFIX='.so' ;; + *) MODULES_SECONDARY_SUFFIX='' ;; +esac if test "${with_modules}" != "no"; then case $opsys in gnu|gnu-linux) @@ -3708,19 +3696,26 @@ if test "${HAVE_MODULES}" = yes; then AC_DEFINE(HAVE_MODULES, 1, [Define to 1 if dynamic modules are enabled]) AC_DEFINE_UNQUOTED(MODULES_SUFFIX, "$MODULES_SUFFIX", [System extension for dynamic libraries]) + if test -n "${MODULES_SECONDARY_SUFFIX}"; then + AC_DEFINE_UNQUOTED(MODULES_SECONDARY_SUFFIX, "$MODULES_SECONDARY_SUFFIX", + [Alternative system extension for dynamic libraries.]) + fi fi AC_SUBST(MODULES_OBJ) AC_SUBST(LIBMODULES) AC_SUBST(HAVE_MODULES) AC_SUBST(MODULES_SUFFIX) +AC_SUBST(MODULES_SECONDARY_SUFFIX) AC_CONFIG_FILES([src/emacs-module.h]) AC_SUBST_FILE([module_env_snippet_25]) AC_SUBST_FILE([module_env_snippet_26]) AC_SUBST_FILE([module_env_snippet_27]) +AC_SUBST_FILE([module_env_snippet_28]) module_env_snippet_25="$srcdir/src/module-env-25.h" module_env_snippet_26="$srcdir/src/module-env-26.h" module_env_snippet_27="$srcdir/src/module-env-27.h" +module_env_snippet_28="$srcdir/src/module-env-28.h" emacs_major_version="${PACKAGE_VERSION%%.*}" AC_SUBST(emacs_major_version) @@ -4219,6 +4214,12 @@ dnl No need to check for posix_memalign if aligned_alloc works. AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break]) AC_CHECK_DECLS([aligned_alloc], [], [], [[#include <stdlib.h>]]) +case $with_unexec,$canonical in + yes,alpha*) + AC_CHECK_DECL([__ELF__], [], + [AC_MSG_ERROR([Non-ELF systems are not supported on this platform.])]);; +esac + # Dump loading AC_CHECK_FUNCS([posix_madvise]) @@ -5287,9 +5288,9 @@ if test "${HAVE_X_WINDOWS}" = "yes" ; then if test "$HAVE_CAIRO" = "yes"; then FONT_OBJ="$FONT_OBJ ftfont.o ftcrfont.o" elif test "$HAVE_XFT" = "yes"; then - FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o ftxfont.o" + FONT_OBJ="$FONT_OBJ ftfont.o xftfont.o" elif test "$HAVE_FREETYPE" = "yes"; then - FONT_OBJ="$FONT_OBJ ftfont.o ftxfont.o" + FONT_OBJ="$FONT_OBJ ftfont.o" fi fi if test "${HAVE_HARFBUZZ}" = "yes" ; then @@ -5905,6 +5906,21 @@ you can continue to support by using '$0 --with-pop'.]) esac fi +if test "${HAVE_XFT}" = yes; then + AC_MSG_WARN([This configuration uses libXft, which has a number of + font rendering issues, and is being considered for removal in the + next release of Emacs. Please consider using Cairo graphics + + HarfBuzz text shaping instead (they are auto-detected if the + relevant development headers are installed).]) +fi + +if test "${HAVE_CAIRO}" = "yes" && test "${HAVE_HARFBUZZ}" = no; then + AC_MSG_WARN([This configuration uses the Cairo graphics library, + but not the HarfBuzz font shaping library. We recommend the use + of HarfBuzz when using Cairo, please install HarfBuzz development + packages.]) +fi + # Let plain 'make' work. test "$MAKE" = make || test -f makefile || cat >makefile <<EOF .POSIX: diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index d3fda285f26..9303b0b8dd1 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -565,12 +565,6 @@ is found there. @item HOSTNAME @vindex HOSTNAME@r{, environment variable} The name of the machine that Emacs is running on. -@c complete.el is obsolete since 24.1. -@ignore -@item INCPATH -A colon-separated list of directories. Used by the @code{complete} package -to search for files. -@end ignore @item INFOPATH @vindex INFOPATH@r{, environment variable} A colon-separated list of directories in which to search for Info files. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 8444aef3bdd..4ecebc7a270 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1654,6 +1654,8 @@ Customization}). (The other attributes of this face have no effect; the text shown under the cursor is drawn using the frame's background color.) To change its shape, customize the buffer-local variable @code{cursor-type}; possible values are @code{box} (the default), +@code{(box . @var{size})} (box cursor becoming a hollow box under +masked images larger than @var{size} pixels in either dimension), @code{hollow} (a hollow box), @code{bar} (a vertical bar), @code{(bar . @var{n})} (a vertical bar @var{n} pixels wide), @code{hbar} (a horizontal bar), @code{(hbar . @var{n})} (a horizontal bar @var{n} diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 3665faf3a8f..2c268f14fb7 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -66,6 +66,7 @@ changes have already been undone, the undo command signals an error. @cindex redo @findex undo-only +@findex undo-redo Any command other than an undo command breaks the sequence of undo commands. Starting from that moment, the entire sequence of undo commands that you have just performed are themselves placed into the @@ -76,7 +77,9 @@ undo commands. Alternatively, if you want to resume undoing, without redoing previous undo commands, use @kbd{M-x undo-only}. This is like -@code{undo}, but will not redo changes you have just undone. +@code{undo}, but will not redo changes you have just undone. To +complement it, @kbd{M-x undo-redo} will undo previous undo commands +(and will not record itself as an undoable command). If you notice that a buffer has been modified accidentally, the easiest way to recover is to type @kbd{C-/} repeatedly until the stars diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index fce6720b934..49c53c5cbc0 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -601,6 +601,11 @@ is @key{ESC}, because @kbd{@key{ESC} C-h} is actually @kbd{C-M-h}, which marks a defun. However, @w{@kbd{@key{ESC} @key{F1}}} and @w{@kbd{@key{ESC} ?}} work fine.) +@findex describe-keymap +Finally, @kbd{M-x describe-keymap} prompts for the name of a keymap, +with completion, and displays a listing of all key bindings in that +keymap. + @node Help Files @section Help Files diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index fc2d2d8c84d..b18c334acf4 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -72,6 +72,10 @@ number, in which case Emacs will show the binding for that many seconds before removing it from display. The default behavior is to display the binding for 2 seconds. +Additionally, when @code{suggest-key-bindings} is non-@code{nil}, the +completion list of @kbd{M-x} shows equivalent key bindings for all +commands that have them. + @vindex extended-command-suggest-shorter Commands that don't have key bindings, can still be invoked after typing less than their full name at the @samp{M-x} prompt. Emacs diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 6bf4fc7e10c..db3cf317ff1 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -151,27 +151,6 @@ Refresh the package list (@code{revert-buffer}). This fetches the list of available packages from the package archive again, and redisplays the package list. -@item / k -@kindex / k @r{(Package Menu)} -@findex package-menu-filter-by-keyword -Filter the package list by keyword -(@code{package-menu-filter-by-keyword}). This prompts for a keyword -(e.g., @samp{games}), then shows only the packages that relate to that -keyword. - -@item / n -@kindex / n @r{(Package Menu)} -@findex package-menu-filter-by-name -Filter the package list by name (@code{package-menu-filter-by-name}). -This prompts for a string, then shows only the packages whose names -match a regexp with that value. - -@item / / -@kindex / / @r{(Package Menu)} -@findex package-menu-clear-filter -Clear filter currently applied to the package list -(@code{package-menu-clear-filter}). - @item H @kindex H @r{(Package Menu)} @findex package-menu-hide-package @@ -186,6 +165,48 @@ pressing @key{RET} to the prompt will hide the current package. @findex package-menu-toggle-hiding Toggle visibility of old versions of packages and also of versions from lower-priority archives (@code{package-menu-toggle-hiding}). + +@item / a +@kindex / a @r{(Package Menu)} +@findex package-menu-filter-by-archive +Filter package list by archive (@code{package-menu-filter-by-archive}). +This prompts for a package archive (e.g., @samp{gnu}), then shows only +packages from that archive. + +@item / k +@kindex / k @r{(Package Menu)} +@findex package-menu-filter-by-keyword +Filter package list by keyword (@code{package-menu-filter-by-keyword}). +This prompts for a keyword (e.g., @samp{games}), then shows only +packages with that keyword. + +@item / n +@kindex / n @r{(Package Menu)} +@findex package-menu-filter-by-name +Filter package list by name (@code{package-menu-filter-by-name}). +This prompts for a regular expression, then shows only packages +with names matching that regexp. + +@item / s +@kindex / s @r{(Package Menu)} +@findex package-menu-filter-by-status +Filter package list by status (@code{package-menu-filter-by-status}). +This prompts for one or more statuses (e.g., @samp{available}), then +shows only packages with matching status. + +@item / v +@kindex / v @r{(Package Menu)} +@findex package-menu-filter-by-version +Filter package list by version (@code{package-menu-filter-by-version}). +This prompts first for one of the qualifiers @samp{<}, @samp{>} or +@samp{=}, and then a package version, and shows packages that has a +lower, equal or higher version than the one specified. + +@item / / +@kindex / / @r{(Package Menu)} +@findex package-menu-filter-clear +Clear filter currently applied to the package list +(@code{package-menu-filter-clear}). @end table @noindent diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 9e23f055f53..9834952566f 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -929,7 +929,7 @@ GNU Emacs Lisp is largely inspired by Maclisp, which was written at MIT in the 1960s. It is somewhat inspired by Common Lisp, which became a standard in the 1980s. However, Emacs Lisp is much simpler than Common Lisp. (The standard Emacs distribution contains an optional extensions -file, @file{cl.el}, that adds many Common Lisp features to Emacs Lisp.) +file, @file{cl-lib.el}, that adds many Common Lisp features to Emacs Lisp.) @node Note for Novices @unnumberedsec A Note for Novices diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 8be8307c75f..cfef5c12d1e 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1362,6 +1362,11 @@ while matching the remainder of the specifications at this level. This is primarily used to generate more specific syntax error messages. See @ref{Backtracking}, for more details. Also see the @code{let} example. +@item &error +@code{&error} should be followed by a string, an error message, in the +edebug-spec; it aborts the instrumentation, displaying the message in +the minibuffer. + @item @var{other-symbol} @cindex indirect specifications Any other symbol in a specification list may be a predicate or an diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index d855ecc0b96..caa08ffb1de 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2192,10 +2192,11 @@ it and see if it works.) @vindex ns-appearance@r{, a frame parameter} @item ns-appearance Only available on macOS, if set to @code{dark} draw this frame's -window-system window using the ``vibrant dark'' theme, otherwise use -the system default. The ``vibrant dark'' theme can be used to set the -toolbar and scrollbars to a dark appearance when using an Emacs theme -with a dark background. +window-system window using the ``vibrant dark'' theme, and if set to +@code{light} use the ``aqua'' theme, otherwise use the system default. +The ``vibrant dark'' theme can be used to set the toolbar and +scrollbars to a dark appearance when using an Emacs theme with a dark +background. @vindex ns-transparent-titlebar@r{, a frame parameter} @item ns-transparent-titlebar @@ -2219,6 +2220,9 @@ How to display the cursor. Legitimate values are: @table @code @item box Display a filled box. (This is the default.) +@item (box . @var{size}) +Display a filled box. However, display it as a hollow box if point is +under masked image larger than @var{size} pixels in either dimension. @item hollow Display a hollow box. @item nil diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 325841d8f8a..442f6d156b6 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1228,9 +1228,9 @@ the @var{runtime} structure with the value compiled into the module: @example int -emacs_module_init (struct emacs_runtime *ert) +emacs_module_init (struct emacs_runtime *runtime) @{ - if (ert->size < sizeof (*ert)) + if (runtime->size < sizeof (*runtime)) return 1; @} @end example @@ -1247,7 +1247,7 @@ assumes it is part of the @code{emacs_module_init} function shown above: @example - emacs_env *env = ert->get_environment (ert); + emacs_env *env = runtime->get_environment (runtime); if (env->size < sizeof (*env)) return 2; @end example @@ -1264,7 +1264,7 @@ Emacs, by comparing the size of the environment passed by Emacs with known sizes, like this: @example - emacs_env *env = ert->get_environment (ert); + emacs_env *env = runtime->get_environment (runtime); if (env->size >= sizeof (struct emacs_env_26)) emacs_version = 26; /* Emacs 26 or later. */ else if (env->size >= sizeof (struct emacs_env_25)) @@ -1314,7 +1314,8 @@ subsection describes how to write such @dfn{module functions}. A module function has the following general form and signature: -@deftypefn Function emacs_value module_func (emacs_env *@var{env}, ptrdiff_t @var{nargs}, emacs_value *@var{args}, void *@var{data}) +@deftypefn Function emacs_value emacs_function (emacs_env *@var{env}, ptrdiff_t @var{nargs}, emacs_value *@var{args}, void *@var{data}) +@tindex emacs_function The @var{env} argument provides a pointer to the @acronym{API} environment, needed to access Emacs objects and functions. The @var{nargs} argument is the required number of arguments, which can be @@ -1323,7 +1324,7 @@ of the argument number), and @var{args} is a pointer to the array of the function arguments. The argument @var{data} points to additional data required by the function, which was arranged when @code{make_function} (see below) was called to create an Emacs -function from @code{module_func}. +function from @code{emacs_function}. Module functions use the type @code{emacs_value} to communicate Lisp objects between Emacs and the module (@pxref{Module Values}). The @@ -1338,6 +1339,10 @@ However, if the user typed @kbd{C-g}, or if the module function or its callees signaled an error or exited nonlocally (@pxref{Module Nonlocal}), Emacs will ignore the returned value and quit or throw as it does when Lisp code encounters the same situations. + +The header @file{emacs-module.h} provides the type +@code{emacs_function} as an alias type for a function pointer to a +module function. @end deftypefn After writing your C code for a module function, you should make a @@ -1348,11 +1353,11 @@ normally done in the module initialization function (@pxref{module initialization function}), after verifying the @acronym{API} compatibility. -@deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, subr @var{func}, const char *@var{docstring}, void *@var{data}) +@deftypefn Function emacs_value make_function (emacs_env *@var{env}, ptrdiff_t @var{min_arity}, ptrdiff_t @var{max_arity}, emacs_function @var{func}, const char *@var{docstring}, void *@var{data}) @vindex emacs_variadic_function This returns an Emacs function created from the C function @var{func}, -whose signature is as described for @code{module_func} above (assumed -here to be @code{typedef}'ed as @code{subr}). The arguments +whose signature is as described for @code{emacs_function} above. +The arguments @var{min_arity} and @var{max_arity} specify the minimum and maximum number of arguments that @var{func} can accept. The @var{max_arity} argument can have the special value @code{emacs_variadic_function}, @@ -1388,7 +1393,7 @@ Combining the above steps, code that arranges for a C function look like this, as part of the module initialization function: @example - emacs_env *env = ert->get_environment (ert); + emacs_env *env = runtime->get_environment (runtime); emacs_value func = env->make_function (env, min_arity, max_arity, module_func, docstring, data); emacs_value symbol = env->intern (env, "module-func"); @@ -1442,6 +1447,54 @@ The Lisp package which goes with your module could then load the module using the @code{load} primitive (@pxref{Dynamic Modules}) when the package is loaded into Emacs. +@anchor{Module Function Finalizers} +If you want to run some code when a module function object (i.e., an +object returned by @code{make_function}) is garbage-collected, you can +install a @dfn{function finalizer}. Function finalizers are available +since Emacs 28. For example, if you have passed some heap-allocated +structure to the @var{data} argument of @code{make_function}, you can +use the finalizer to deallocate the structure. @xref{Basic +Allocation,,,libc}, and @pxref{Freeing after Malloc,,,libc}. The +finalizer function has the following signature: + +@example +void finalizer (void *@var{data}) +@end example + +Here, @var{data} receives the value passed to @var{data} when calling +@code{make_function}. Note that the finalizer can't interact with +Emacs in any way. + +Directly after calling @code{make_function}, the newly-created +function doesn't have a finalizer. Use @code{set_function_finalizer} +to add one, if desired. + +@deftypefun void emacs_finalizer (void *@var{ptr}) +The header @file{emacs-module.h} provides the type +@code{emacs_finalizer} as a type alias for an Emacs finalizer +function. +@end deftypefun + +@deftypefun emacs_finalizer get_function_finalizer (emacs_env *@var{env}, emacs_value @var{arg}) +This function, which is available since Emacs 28, returns the function +finalizer associated with the module function represented by +@var{arg}. @var{arg} must refer to a module function, that is, an +object returned by @code{make_function}. If no finalizer is +associated with the function, @code{NULL} is returned. +@end deftypefun + +@deftypefun void set_function_finalizer (emacs_env *@var{env}, emacs_value @var{arg}, emacs_finalizer @var{fin}) +This function, which is available since Emacs 28, sets the function +finalizer associated with the module function represented by @var{arg} +to @var{fin}. @var{arg} must refer to a module function, that is, an +object returned by @code{make_function}. @var{fin} can either be +@code{NULL} to clear @var{arg}'s function finalizer, or a pointer to a +function to be called when the object represented by @var{arg} is +garbage-collected. At most one function finalizer can be set per +function; if @var{arg} already has a finalizer, it is replaced by +@var{fin}. +@end deftypefun + @node Module Values @subsection Conversion Between Lisp and Module Values @cindex module values, conversion @@ -1541,12 +1594,11 @@ This function returns the value of a Lisp float specified by @var{arg}, as a C @code{double} value. @end deftypefn -@deftypefn Function struct timespec extract_time (emacs_env *@var{env}, emacs_value @var{time}) -This function, which is available since Emacs 27, interprets -@var{time} as an Emacs Lisp time value and returns the corresponding -@code{struct timespec}. @xref{Time of Day}. @code{struct timespec} -represents a timestamp with nanosecond precision. It has the -following members: +@deftypefn Function struct timespec extract_time (emacs_env *@var{env}, emacs_value @var{arg}) +This function, which is available since Emacs 27, interprets @var{arg} +as an Emacs Lisp time value and returns the corresponding @code{struct +timespec}. @xref{Time of Day}. @code{struct timespec} represents a +timestamp with nanosecond precision. It has the following members: @table @code @item time_t tv_sec @@ -1744,9 +1796,9 @@ next_prime (emacs_env *env, ptrdiff_t nargs, emacs_value *args, @} int -emacs_module_init (struct emacs_runtime *ert) +emacs_module_init (struct emacs_runtime *runtime) @{ - emacs_env *env = ert->get_environment (ert); + emacs_env *env = runtime->get_environment (runtime); emacs_value symbol = env->intern (env, "next-prime"); emacs_value func = env->make_function (env, 1, 1, next_prime, NULL, NULL); @@ -1773,16 +1825,15 @@ there's no requirement that @var{time} be normalized. This means that @code{@var{time}.tv_nsec} can be negative or larger than 999,999,999. @end deftypefn -@deftypefn Function emacs_value make_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{strlen}) +@deftypefn Function emacs_value make_string (emacs_env *@var{env}, const char *@var{str}, ptrdiff_t @var{len}) This function creates an Emacs string from C text string pointed by @var{str} whose length in bytes, not including the terminating null -byte, is @var{strlen}. The original string in @var{str} can be either -an @acronym{ASCII} string or a UTF-8 encoded non-@acronym{ASCII} -string; it can include embedded null bytes, and doesn't have to end in -a terminating null byte at @code{@var{str}[@var{strlen}]}. The -function raises the @code{overflow-error} error condition if -@var{strlen} is negative or exceeds the maximum length of an Emacs -string. +byte, is @var{len}. The original string in @var{str} can be either an +@acronym{ASCII} string or a UTF-8 encoded non-@acronym{ASCII} string; +it can include embedded null bytes, and doesn't have to end in a +terminating null byte at @code{@var{str}[@var{len}]}. The function +raises the @code{overflow-error} error condition if @var{len} is +negative or exceeds the maximum length of an Emacs string. @end deftypefn The @acronym{API} does not provide functions to manipulate Lisp data @@ -1839,27 +1890,32 @@ garbage-collected. Don't run any expensive code in a finalizer, because GC must finish quickly to keep Emacs responsive. @end deftypefn -@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value val) +@deftypefn Function void *get_user_ptr (emacs_env *@var{env}, emacs_value @var{arg}) This function extracts the C pointer from the Lisp object represented -by @var{val}. +by @var{arg}. @end deftypefn -@deftypefn Function void set_user_ptr (emacs_env *@var{env}, emacs_value @var{value}, void *@var{ptr}) +@deftypefn Function void set_user_ptr (emacs_env *@var{env}, emacs_value @var{arg}, void *@var{ptr}) This function sets the C pointer embedded in the @code{user-ptr} -object represented by @var{value} to @var{ptr}. +object represented by @var{arg} to @var{ptr}. @end deftypefn -@deftypefn Function emacs_finalizer get_user_finalizer (emacs_env *@var{env}, emacs_value val) +@deftypefn Function emacs_finalizer get_user_finalizer (emacs_env *@var{env}, emacs_value @var{arg}) This function returns the finalizer of the @code{user-ptr} object -represented by @var{val}, or @code{NULL} if it doesn't have a finalizer. +represented by @var{arg}, or @code{NULL} if it doesn't have a +finalizer. @end deftypefn -@deftypefn Function void set_user_finalizer (emacs_env *@var{env}, emacs_value @var{val}, emacs_finalizer @var{fin}) +@deftypefn Function void set_user_finalizer (emacs_env *@var{env}, emacs_value @var{arg}, emacs_finalizer @var{fin}) This function changes the finalizer of the @code{user-ptr} object -represented by @var{val} to be @var{fin}. If @var{fin} is a -@code{NULL} pointer, the @code{user-ptr} object will have no finalizer. +represented by @var{arg} to be @var{fin}. If @var{fin} is a +@code{NULL} pointer, the @code{user-ptr} object will have no +finalizer. @end deftypefn +Note that the @code{emacs_finalizer} type works for both user pointer +an module function finalizers. @xref{Module Function Finalizers}. + @node Module Misc @subsection Miscellaneous Convenience Functions for Modules @@ -1870,20 +1926,20 @@ be called via the @code{emacs_env} pointer. Description of functions that were introduced after Emacs 25 calls out the first version where they became available. -@deftypefn Function bool eq (emacs_env *@var{env}, emacs_value @var{val1}, emacs_value @var{val2}) +@deftypefn Function bool eq (emacs_env *@var{env}, emacs_value @var{a}, emacs_value @var{b}) This function returns @code{true} if the Lisp objects represented by -@var{val1} and @var{val2} are identical, @code{false} otherwise. This -is the same as the Lisp function @code{eq} (@pxref{Equality -Predicates}), but avoids the need to intern the objects represented by -the arguments. +@var{a} and @var{b} are identical, @code{false} otherwise. This is +the same as the Lisp function @code{eq} (@pxref{Equality Predicates}), +but avoids the need to intern the objects represented by the +arguments. There are no @acronym{API} functions for other equality predicates, so you will need to use @code{intern} and @code{funcall}, described below, to perform more complex equality tests. @end deftypefn -@deftypefn Function bool is_not_nil (emacs_env *@var{env}, emacs_value @var{val}) -This function tests whether the Lisp object represented by @var{val} +@deftypefn Function bool is_not_nil (emacs_env *@var{env}, emacs_value @var{arg}) +This function tests whether the Lisp object represented by @var{arg} is non-@code{nil}; it returns @code{true} or @code{false} accordingly. Note that you could implement an equivalent test by using @@ -1892,12 +1948,12 @@ then use @code{eq}, described above, to test for equality. But using this function is more convenient. @end deftypefn -@deftypefn Function emacs_value type_of (emacs_env *@var{env}, emacs_value @code{object}) -This function returns the type of @var{object} as a value that -represents a symbol: @code{string} for a string, @code{integer} for an -integer, @code{process} for a process, etc. @xref{Type Predicates}. -You can use @code{intern} and @code{eq} to compare against known type -symbols, if your code needs to depend on the object type. +@deftypefn Function emacs_value type_of (emacs_env *@var{env}, emacs_value @code{arg}) +This function returns the type of @var{arg} as a value that represents +a symbol: @code{string} for a string, @code{integer} for an integer, +@code{process} for a process, etc. @xref{Type Predicates}. You can +use @code{intern} and @code{eq} to compare against known type symbols, +if your code needs to depend on the object type. @end deftypefn @anchor{intern} @@ -1917,8 +1973,7 @@ calling the more powerful Emacs @code{intern} function emacs_value fintern = env->intern (env, "intern"); emacs_value sym_name = env->make_string (env, name_str, strlen (name_str)); -emacs_value intern_args[] = @{ sym_name, env->intern (env, "nil") @}; -emacs_value symbol = env->funcall (env, fintern, 2, intern_args); +emacs_value symbol = env->funcall (env, fintern, 1, &sym_name); @end example @end deftypefn @@ -2071,11 +2126,12 @@ One use of this function is when you want to re-throw a non-local exit from one of the called @acronym{API} or Lisp functions. @end deftypefn -@deftypefn Function void non_local_exit_signal (emacs_env *@var{env}, emacs_value @var{error}, emacs_value @var{data}) -This function signals the error represented by @var{error} with the -specified error data @var{data}. The module function should return -soon after calling this function. This function could be useful, -e.g., for signaling errors from module functions to Emacs. +@deftypefn Function void non_local_exit_signal (emacs_env *@var{env}, emacs_value @var{symbol}, emacs_value @var{data}) +This function signals the error represented by the error symbol +@var{symbol} with the specified error data @var{data}. The module +function should return soon after calling this function. This +function could be useful, e.g., for signaling errors from module +functions to Emacs. @end deftypefn diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 259efea3248..4d513132e9f 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1846,8 +1846,11 @@ local map. @cindex scanning keymaps @cindex keymaps, scanning - This section describes functions used to scan all the current keymaps -for the sake of printing help information. + This section describes functions used to scan all the current +keymaps for the sake of printing help information. To display the +bindings in a particular keymap, you can use the +@code{describe-keymap} command (@pxref{Misc Help, , Other Help +Commands, emacs, The GNU Emacs Manual}) @defun accessible-keymaps keymap &optional prefix This function returns a list of all the keymaps that can be reached (via diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 58936686ad7..28942820793 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1170,10 +1170,13 @@ extension, a.k.a.@: ``suffix''. This suffix is platform-dependent. @defvar module-file-suffix This variable holds the system-dependent value of the file-name -extension of the module files. Its value is @file{.so} on POSIX hosts -and @file{.dll} on MS-Windows. +extension of the module files. Its value is @file{.so} on POSIX +hosts, @file{.dylib} on macOS, and @file{.dll} on MS-Windows. @end defvar + On macOS, dynamic modules can also have the suffix @file{.so} in +addition to @file{.dylib}. + @findex emacs_module_init @vindex plugin_is_GPL_compatible Every dynamic module should export a C-callable function named diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 1266cf8ef65..ac38b9d390d 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -646,6 +646,15 @@ A history list for variable-name arguments read by @code{read-variable}. @end defvar +@defvar read-number-history +A history list for numbers read by @code{read-number}. +@end defvar + +@defvar goto-line-history +A history list for arguments to @code{goto-line}. This variable is +buffer local. +@end defvar + @c Less common: coding-system-history, input-method-history, @c command-history, grep-history, grep-find-history, @c read-envvar-name-history, setenv-history, yes-or-no-p-history. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index a8ddd45f891..f8cf4578fc2 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1428,7 +1428,7 @@ or to switch back to an existing one." (lisp-mode-variables nil t) (setq-local find-tag-default-function 'lisp-find-tag-default) (setq-local comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") (setq imenu-case-fold-search t)) @end group @end smallexample @@ -2673,6 +2673,7 @@ Setting this variable makes it buffer-local in the current buffer. @node Font Lock Mode @section Font Lock Mode @cindex Font Lock mode +@cindex syntax highlighting and coloring @dfn{Font Lock mode} is a buffer-local minor mode that automatically attaches @code{face} properties to certain parts of the buffer based on diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 1c4e7e4d4e3..855dff2130a 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -2338,8 +2338,12 @@ same sequence of character codes and all these codes are in the range @end group @end example -However, two distinct buffers are never considered @code{equal}, even if -their textual contents are the same. +The @code{equal} function recursively compares the contents of objects +if they are integers, strings, markers, vectors, bool-vectors, +byte-code function objects, char-tables, records, or font objects. +Other objects are considered @code{equal} only if they are @code{eq}. +For example, two distinct buffers are never considered @code{equal}, +even if their textual contents are the same. @end defun For @code{equal}, equality is defined recursively; for example, given diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 201ca18c1e4..a034ccdcd5c 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1689,7 +1689,8 @@ following form: @noindent The format of this list is the same as what @code{decode-time} accepts (@pxref{Time Conversion}), and is described in more detail there. Any -element that cannot be determined from the input will be set to +@code{dst} element that cannot be determined from the input is set to +@minus{}1, and any other unknown element is set to @code{nil}. The argument @var{string} should resemble an RFC 822 (or later) or ISO 8601 string, like ``Fri, 25 Mar 2016 16:24:56 +0100'' or ``1998-09-12T12:21:54-0200'', but this function will attempt to parse diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 6970f718ee0..f515213615e 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2426,18 +2426,15 @@ server is stopped; a non-@code{nil} value means yes. @cindex encrypted network connections @cindex @acronym{TLS} network connections @cindex @acronym{STARTTLS} network connections -Emacs can create encrypted network connections, using either built-in -or external support. The built-in support uses the GnuTLS -Transport Layer Security Library; see +Emacs can create encrypted network connections, using the built-in +support for the GnuTLS Transport Layer Security Library; see @uref{https://www.gnu.org/software/gnutls/, the GnuTLS project page}. If your Emacs was compiled with GnuTLS support, the function @code{gnutls-available-p} is defined and returns non-@code{nil}. For more details, @pxref{Top,, Overview, emacs-gnutls, The Emacs-GnuTLS manual}. -The external support uses the @file{starttls.el} library, which -requires a helper utility such as @command{gnutls-cli} to be installed -on the system. The @code{open-network-stream} function can -transparently handle the details of creating encrypted connections for -you, using whatever support is available. +The @code{open-network-stream} function can transparently handle the +details of creating encrypted connections for you, using whatever +support is available. @defun open-network-stream name buffer host service &rest parameters This function opens a TCP connection, with optional encryption, and diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index c9301c9d186..d0791d40196 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5915,10 +5915,6 @@ This function compares two window configurations as regards the structure of windows, but ignores the values of point and the saved scrolling positions---it can return @code{t} even if those aspects differ. - -The function @code{equal} can also compare two window configurations; it -regards configurations as unequal if they differ in any respect, even a -saved point. @end defun @defun window-configuration-frame config diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index f9196f808e7..1dab29b8a5a 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35164,16 +35164,7 @@ which are called at various times. Calc defines a number of hooks that help you to customize it in various ways. Calc uses the Lisp function @code{run-hooks} to invoke the hooks shown below. Several other customization-related variables are also described here. - -@defvar calc-load-hook -This hook is called at the end of @file{calc.el}, after the file has -been loaded, before any functions in it have been called, but after -@code{calc-mode-map} and similar variables have been set up. -@end defvar - -@defvar calc-ext-load-hook -This hook is called at the end of @file{calc-ext.el}. -@end defvar +To run code after Calc has loaded, use @code{with-eval-after-load}. @defvar calc-start-hook This hook is called as the last step in a @kbd{M-x calc} command. diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 5965da16bb7..d7497806602 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -185,13 +185,12 @@ In your @file{~/.emacs} file, or in the system-wide initialization file @file{default.el} in the @file{site-lisp} directory, put @example -(add-hook 'dired-load-hook - (lambda () - (load "dired-x") - ;; Set dired-x global variables here. For example: - ;; (setq dired-guess-shell-gnutar "gtar") - ;; (setq dired-x-hands-off-my-keys nil) - )) +(with-eval-after-load 'dired + (require 'dired-x) + ;; Set dired-x global variables here. For example: + ;; (setq dired-guess-shell-gnutar "gtar") + ;; (setq dired-x-hands-off-my-keys nil) + )) (add-hook 'dired-mode-hook (lambda () ;; Set dired-x buffer-local variables here. For example: @@ -242,12 +241,10 @@ If you choose to have @file{dired-x.el} bind @code{dired-x-find-file} over or call @code{dired-x-bind-find-file} after changing the value. @example -(add-hook 'dired-load-hook - (lambda () - ;; Bind dired-x-find-file. - (setq dired-x-hands-off-my-keys nil) - (load "dired-x") - )) +(with-eval-after-load 'dired + ;; Bind dired-x-find-file. + (setq dired-x-hands-off-my-keys nil) + (require 'dired-x)) @end example @node Omitting Files in Dired @@ -294,8 +291,8 @@ Marked files are never omitted. @end table @noindent -In order to make Dired Omit work you first need to load @file{dired-x.el} -inside @code{dired-load-hook} (@pxref{Installation}) and then evaluate +In order to make Dired Omit work you need to load @file{dired-x} +after loading @file{dired} (@pxref{Installation}) and then evaluate @code{(dired-omit-mode 1)} in some way (@pxref{Omitting Variables}). @ifnottex @@ -410,7 +407,7 @@ The default value is @kbd{C-o}. @item @cindex RCS files, how to omit them in Dired @cindex omitting RCS files in Dired -If you wish to avoid seeing RCS files and the @file{RCS} directory, then put +If you wish to avoid seeing RCS files and the @file{RCS} directory, then use @example (setq dired-omit-files @@ -418,7 +415,7 @@ If you wish to avoid seeing RCS files and the @file{RCS} directory, then put @end example @noindent -in the @code{dired-load-hook} (@pxref{Installation}). This assumes +after loading @file{dired-x} (@pxref{Installation}). This assumes @code{dired-omit-localp} has its default value of @code{no-dir} to make the @code{^}-anchored matches work. As a slower alternative, with @code{dired-omit-localp} set to @code{nil}, you can use @code{/} instead of @@ -429,7 +426,7 @@ in the @code{dired-load-hook} (@pxref{Installation}). This assumes @cindex omitting tib files in Dired If you use @code{tib}, the bibliography program for use with @TeX{} and @LaTeX{}, and you -want to omit the @file{INDEX} and the @file{*-t.tex} files, then put +want to omit the @file{INDEX} and the @file{*-t.tex} files, then use @example (setq dired-omit-files @@ -437,13 +434,13 @@ want to omit the @file{INDEX} and the @file{*-t.tex} files, then put @end example @noindent -in the @code{dired-load-hook} (@pxref{Installation}). +after loading @file{dired-x} (@pxref{Installation}). @item @cindex dot files, how to omit them in Dired @cindex omitting dot files in Dired If you do not wish to see @samp{dot} files (files starting with a @file{.}), -then put +then use @example (setq dired-omit-files @@ -451,7 +448,7 @@ then put @end example @noindent -in the @code{dired-load-hook} (@pxref{Installation}). (Of course, a +after loading @file{dired-x} (@pxref{Installation}). (Of course, a better way to achieve this particular goal is simply to omit @samp{-a} from @code{dired-listing-switches}.) @@ -830,7 +827,7 @@ When installed @file{dired-x} will substitute @code{dired-x-find-file} for (normally bound to @kbd{C-x 4 C-f}). In order to use this feature, you will need to set -@code{dired-x-hands-off-my-keys} to @code{nil} inside @code{dired-load-hook} +@code{dired-x-hands-off-my-keys} to @code{nil} before loading @file{dired-x} (@pxref{Optional Installation File At Point}). @table @code diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 99ba89b0d7f..1ef13716b11 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -1197,10 +1197,6 @@ refer to Emacs manual for the information on how to set Emacs X resources. The bulk of customization can be done via the following hooks: @table @code -@item ediff-load-hook -@vindex ediff-load-hook -This hook can be used to change defaults after Ediff is loaded. - @item ediff-before-setup-hook @vindex ediff-before-setup-hook Hook that is run just before Ediff rearranges windows to its liking. @@ -1211,8 +1207,8 @@ Can be used to save windows configuration. @vindex ediff-mode-map This hook can be used to alter bindings in Ediff's keymap, @code{ediff-mode-map}. These hooks are -run right after the default bindings are set but before -@code{ediff-load-hook}. The regular user needs not be concerned with this +run right after the default bindings are set. +The regular user needs not be concerned with this hook---it is provided for implementers of other Emacs packages built on top of Ediff. @@ -1545,12 +1541,13 @@ directly (using @kbd{j}) to any numbered difference. Users can supply their own functions to specify how Ediff should do -selective browsing. To change the default Ediff function, add a function to -@code{ediff-load-hook} which will do the following assignments: +selective browsing. To change the default Ediff function, use +something like the following: @example -(setq ediff-hide-regexp-matches-function 'your-hide-function) -(setq ediff-focus-on-regexp-matches-function 'your-focus-function) +(with-eval-after-load 'ediff + (setq ediff-hide-regexp-matches-function 'your-hide-function) + (setq ediff-focus-on-regexp-matches-function 'your-focus-function)) @end example @strong{Useful hint}: To specify a regexp that matches everything, don't @@ -1728,23 +1725,17 @@ difference region in buffer A (this face is not a good choice, by the way). If you are unhappy with just @emph{some} of the aspects of the default faces, you can modify them when Ediff is being loaded using -@code{ediff-load-hook}. For instance: +@code{with-eval-after-load}. For instance: @smallexample -(add-hook 'ediff-load-hook - (lambda () - (set-face-foreground - ediff-current-diff-face-B "blue") - (set-face-background - ediff-current-diff-face-B "red") - (make-face-italic - ediff-current-diff-face-B))) +(with-eval-after-load 'ediff + (set-face-foreground + ediff-current-diff-face-B "blue") + (set-face-background + ediff-current-diff-face-B "red") + (make-face-italic ediff-current-diff-face-B)) @end smallexample -@strong{Please note:} to set Ediff's faces, use only @code{copy-face} -or @code{set/make-face-@dots{}} as shown above. Emacs's low-level -face-manipulation functions should be avoided. - @node Narrowing @section Narrowing diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 962f76d1796..50a208d233b 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2515,9 +2515,8 @@ To avoid seeing backup files (and other ``uninteresting'' files) in Dired, load @code{dired-x} by adding the following to your @file{.emacs} file: @lisp -(add-hook 'dired-load-hook - (lambda () - (require 'dired-x))) +(with-eval-after-load 'dired + (require 'dired-x)) @end lisp With @code{dired-x} loaded, @kbd{M-o} toggles omitting in each dired buffer. diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi index 55320bf4c32..9a14a95f797 100644 --- a/doc/misc/gnus-coding.texi +++ b/doc/misc/gnus-coding.texi @@ -96,16 +96,6 @@ Read passwords from user, possibly using a password cache. @c As of 2005-10-21... There are no Gnus dependencies in this file. -@item tls.el -TLS/SSL support via wrapper around GnuTLS -@c As of 2005-10-21... -There are no Gnus dependencies in this file. - -@item pgg*.el -Glue for the various PGP implementations. -@c As of 2005-10-21... -There are no Gnus dependencies in these files. - @item sha1.el SHA1 Secure Hash Algorithm. @c As of 2007-08-25... diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index fbdf09420a9..b5eb81b787e 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -1563,12 +1563,6 @@ secondary select methods. @table @code -@item gnus-load-hook -@vindex gnus-load-hook -A hook run while Gnus is being loaded. Note that this hook will -normally be run just once in each Emacs session, no matter how many -times you start Gnus. - @item gnus-before-startup-hook @vindex gnus-before-startup-hook A hook called as the first thing when Gnus is started. @@ -27910,7 +27904,7 @@ The revised Gnus @acronym{FAQ} is included in the manual, @acronym{TLS} wrapper shipped with Gnus @acronym{TLS}/@acronym{SSL} is now supported in @acronym{IMAP} and -@acronym{NNTP} via @file{tls.el} and GnuTLS. +@acronym{NNTP} via GnuTLS. @item Improved anti-spam features. diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index 547b16622fc..5cb6b19181c 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -1805,8 +1805,8 @@ Structure tag completion is not enabled by default. To enable it, simply add the following to your @file{.emacs}: @lisp - (add-hook 'idlwave-load-hook - (lambda () (require 'idlw-complete-structtag))) +(with-eval-after-load 'idlwave + (require 'idlw-complete-structtag)) @end lisp Once enabled, you'll also be able to access online help on the structure @@ -2360,10 +2360,6 @@ is first called. Normal hook. Executed when a buffer is put into @code{idlwave-mode}. @end defopt -@defopt idlwave-load-hook -Normal hook. Executed when @file{idlwave.el} is loaded. -@end defopt - @node The IDLWAVE Shell @chapter The IDLWAVE Shell @cindex IDLWAVE shell diff --git a/doc/misc/ido.texi b/doc/misc/ido.texi index 74d0bdd29fc..7cc4edd2865 100644 --- a/doc/misc/ido.texi +++ b/doc/misc/ido.texi @@ -590,7 +590,7 @@ Now you can customize @code{completion-ignored-extensions} as well. Go ahead and add all the useless object files, backup files, shared library files and other computing flotsam you don't want Ido to show. -@strong{Note:} Ido will still complete the ignored elements +@strong{Please note:} Ido will still complete the ignored elements if it would otherwise not show any other matches. So if you type out the name of an ignored file, Ido will still let you open it just fine. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 6f6fcd640d0..495d562f50b 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -3979,10 +3979,9 @@ key bindings for this are really too long; you might want to bind this also to @kbd{M-n} and @kbd{M-p}. @lisp -(add-hook 'org-load-hook - (lambda () - (define-key org-mode-map "\M-n" 'org-next-link) - (define-key org-mode-map "\M-p" 'org-previous-link))) +(with-eval-after-load 'org + (define-key org-mode-map "\M-n" 'org-next-link) + (define-key org-mode-map "\M-p" 'org-previous-link)) @end lisp @end table diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 013c5639a1e..0dab5241517 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -2896,9 +2896,8 @@ default. If you want to have these key bindings available, set in your Note that this variable has to be set before @RefTeX{} is loaded to have an effect. -@vindex reftex-load-hook -Changing and adding to @RefTeX{}'s key bindings is best done in the hook -@code{reftex-load-hook}. For information on the keymaps +Changing and adding to @RefTeX{}'s key bindings is best done using +@code{with-eval-after-load}. For information on the keymaps which should be used to add keys, see @ref{Keymaps and Hooks}. @node Faces @@ -5320,10 +5319,6 @@ argument. The keymap for @RefTeX{} mode. @end deffn -@deffn {Normal Hook} reftex-load-hook -Normal hook which is being run when loading @file{reftex.el}. -@end deffn - @deffn {Normal Hook} reftex-mode-hook Normal hook which is being run when turning on @RefTeX{} mode. @end deffn diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi index c02887d104a..d151cee02cc 100644 --- a/doc/misc/sem-user.texi +++ b/doc/misc/sem-user.texi @@ -1068,7 +1068,7 @@ You can integrate @semantic{} with the Speedbar. line to your init file: @example -(add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb))) +(with-eval-after-load 'speedbar (require 'semantic/sb)) @end example @noindent diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index 99612d5c8fb..f29a5a82e86 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -295,26 +295,11 @@ encrypted connection if the server supports it. Other possible values are: @code{starttls} to insist on STARTTLS; @code{ssl} to use TLS/SSL; and @code{plain} for no encryption. -Use of any form of TLS/SSL requires support in Emacs. You can either -use the built-in support (in Emacs 24.1 and later), or the -@file{starttls.el} Lisp library. The built-in support uses the GnuTLS -@footnote{@url{https://www.gnu.org/software/gnutls/}} library. -If your Emacs has GnuTLS support built-in, the function +Use of any form of TLS/SSL requires support in Emacs. You can use the +built-in support for the GnuTLS +@footnote{@url{https://www.gnu.org/software/gnutls/}} library. If your +Emacs has GnuTLS support built-in, the function @code{gnutls-available-p} is defined and returns non-@code{nil}. -Otherwise, you must use the @file{starttls.el} library (see that file for -more information on customization options, etc.). The Lisp library -requires one of the following external tools to be installed: - -@enumerate -@item -The GnuTLS command line tool @samp{gnutls-cli}, which you can get from -@url{https://www.gnu.org/software/gnutls/}. This is the recommended -tool, mainly because it can verify server certificates. - -@item -The @samp{starttls} external program, which you can get from -@file{starttls-*.tar.gz} from @uref{ftp://ftp.opaopa.org/pub/elisp/}. -@end enumerate @cindex certificates @cindex keys diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi index 57ad0220103..c9c3daf963b 100644 --- a/doc/misc/speedbar.texi +++ b/doc/misc/speedbar.texi @@ -828,9 +828,6 @@ Hooks run when speedbar visits a file in the selected frame. @cindex @code{speedbar-visiting-tag-hook} @item speedbar-visiting-tag-hook Hooks run when speedbar visits a tag in the selected frame. -@cindex @code{speedbar-load-hook} -@item speedbar-load-hook -Hooks run when speedbar is loaded. @cindex @code{speedbar-reconfigure-keymaps-hook} @item speedbar-reconfigure-keymaps-hook Hooks run when the keymaps are regenerated. Keymaps are reconfigured @@ -913,12 +910,11 @@ bindings: This function creates a special keymap for use in speedbar. @item -Call your install function, or assign it to a hook like this: +Call your install function, like this: @smallexample -(if (featurep 'speedbar) - (@var{name}-install-speedbar-variables) - (add-hook 'speedbar-load-hook '@var{name}-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (@var{name}-install-speedbar-variables)) @end smallexample @item diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 6d9d7113f77..deca5991870 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2019-09-24.13} +\def\texinfoversion{2020-02-11.09} % -% Copyright 1985--1986, 1988, 1990--2020 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -373,12 +373,12 @@ % Common context changes for both heading and footing. % Do this outside of the \shipout so @code etc. will be expanded in % the headline as they should be, not taken literally (outputting ''code). - \def\commmonheadfootline{\let\hsize=\txipagewidth \texinfochars} + \def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars} % - \global\setbox\headlinebox = \vbox{\commmonheadfootline \makeheadline}% + \global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}% % \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi - \global\setbox\footlinebox = \vbox{\commmonheadfootline \makefootline}% + \global\setbox\footlinebox = \vbox{\commonheadfootline \makefootline}% % {% % Set context for writing to auxiliary files like index files. @@ -3107,9 +3107,9 @@ end % preferrable one choice is over the other. \def\urefallowbreak{% \allowbreak - \hskip 0pt plus 4 em\relax - \penalty100 - \hskip 0pt plus -4 em\relax + \hskip 0pt plus 2 em\relax + \penalty300 + \hskip 0pt plus -2 em\relax } \urefbreakstyle after @@ -7690,7 +7690,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % If SUBTOPIC is present, precede it with a space, and call \doind. % (At some time during the 20th century, this made a two-level entry in an % index such as the operation index. Nobody seemed to notice the change in -% behavior though.) +% behaviour though.) \def\dosubind#1#2#3{% \def\thirdarg{#3}% \ifx\thirdarg\empty @@ -8955,17 +8955,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% \else % Reference within this manual. % - % _ (for example) has to be the character _ for the purposes of the - % control sequence corresponding to the node, but it has to expand - % into the usual \leavevmode...\vrule stuff for purposes of - % printing. So we \turnoffactive for the \refx-snt, back on for the - % printing, back off for the \refx-pg. - {\turnoffactive - % Only output a following space if the -snt ref is nonempty; for - % @unnumbered and @anchor, it won't be. - \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% - \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi - }% + % Only output a following space if the -snt ref is nonempty; for + % @unnumbered and @anchor, it won't be. + \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% + \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi + % % output the `[mynode]' via the macro below so it can be overridden. \xrefprintnodename\printedrefname % @@ -9055,7 +9049,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \requireauxfile {% \indexnofonts - \otherbackslash + \turnoffactive \def\value##1{##1}% \expandafter\global\expandafter\let\expandafter\thisrefX \csname XR#1\endcsname diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 49c32ac3f17..61cf373024f 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -46,7 +46,7 @@ copy and modify this GNU manual.'' @node Top, Overview, (dir), (dir) @top @value{tramp} @value{trampver} User Manual -This file documents @value{tramp} @value{trampver}, a remote file +This file documents @w{@value{tramp} @value{trampver}}, a remote file editing package for Emacs. @value{tramp} stands for ``Transparent Remote (file) Access, Multiple @@ -312,7 +312,7 @@ behind the scenes when you open a file with @value{tramp}. @cindex GNU ELPA @vindex tramp-version -@value{tramp} is included as part of Emacs (since Emacs 22.1). +@value{tramp} is included as part of Emacs (since @w{Emacs 22.1}). @value{tramp} is also freely packaged for download on the Internet at @uref{https://ftp.gnu.org/gnu/tramp/}. The version number of @@ -324,9 +324,9 @@ A @value{tramp} release, which is packaged with Emacs, could differ slightly from the corresponding standalone release. This is because it isn't always possible to synchronize release dates between Emacs and @value{tramp}. Such version numbers have the Emacs version number -as suffix, like ``2.3.5.26.3''. This means @value{tramp} 2.3.5 as -integrated in Emacs 26.3. A complete list of @value{tramp} versions -packaged with Emacs can be retrieved by +as suffix, like ``2.3.5.26.3''. This means @w{@value{tramp} 2.3.5} as +integrated in @w{Emacs 26.3}. A complete list of @value{tramp} +versions packaged with Emacs can be retrieved by @vindex customize-package-emacs-version-alist @lisp @@ -557,13 +557,16 @@ of the local file name is the share exported by the remote host, @cindex method @option{davs} @cindex @option{dav} method @cindex @option{davs} method +@cindex method @option{media} +@cindex @option{media} method On systems, which have installed @acronym{GVFS, the GNOME Virtual File System}, its offered methods could be used by @value{tramp}. Examples are @file{@trampfn{sftp,user@@host,/path/to/file}}, @file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP -file system), @file{@trampfn{dav,user@@host,/path/to/file}} and -@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares). +file system), @file{@trampfn{dav,user@@host,/path/to/file}}, +@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares) and +@file{@trampfn{media,device,/path/to/file}} (for media devices). @anchor{Quick Start Guide: GNOME Online Accounts based methods} @@ -1126,7 +1129,8 @@ Emacs. @value{tramp} does not require a host name part of the remote file name when a single Android device is connected to @command{adb}. @value{tramp} instead uses @file{@trampfn{adb,,}} as the default name. -@command{adb devices} shows available host names. +@command{adb devices}, run in a shell outside Emacs, shows available +host names. @option{adb} method normally does not need user name to authenticate on the Android device because it runs under the @command{adbd} @@ -1227,6 +1231,7 @@ supported by these methods. See method @option{nextcloud} for handling them. @item @option{gdrive} +@cindex @acronym{GNOME} Online Accounts @cindex method @option{gdrive} @cindex @option{gdrive} method @cindex google drive @@ -1242,8 +1247,26 @@ Since Google Drive uses cryptic blob file names internally, could produce unexpected behavior in case two files in the same directory have the same @code{display-name}, such a situation must be avoided. +@item @option{media} +@cindex method @option{media} +@cindex @option{media} method +@cindex media + +Media devices, like cell phones, tablets, cameras, can be accessed via +the @option{media} method. Just the device name is needed in order to +specify the host in the file name. However, the device must already +be connected via USB, before accessing it. Possible device names are +visible via host name completion, @ref{File name completion}. + +Depending on the device type, the access could be read-only. Some +devices are accessible under different names in parallel, offering +different parts of their file system. + +@value{tramp} does not require a host name as part of the remote file +name when a single media device is connected. @value{tramp} instead +uses @file{@trampfn{media,,}} as the default name. + @item @option{nextcloud} -@cindex @acronym{GNOME} Online Accounts @cindex method @option{nextcloud} @cindex @option{nextcloud} method @cindex nextcloud @@ -1267,11 +1290,11 @@ that for security reasons refuse @command{ssh} connections. @defopt tramp-gvfs-methods This user option is a list of external methods for @acronym{GVFS}@. By default, this list includes @option{afp}, @option{dav}, -@option{davs}, @option{gdrive}, @option{nextcloud} and @option{sftp}. -Other methods to include are @option{ftp}, @option{http}, -@option{https} and @option{smb}. These methods are not intended to be -used directly as @acronym{GVFS}-based method. Instead, they are added -here for the benefit of @ref{Archive file names}. +@option{davs}, @option{gdrive}, @option{media}, @option{nextcloud} and +@option{sftp}. Other methods to include are @option{ftp}, +@option{http}, @option{https} and @option{smb}. These methods are not +intended to be used directly as @acronym{GVFS}-based method. Instead, +they are added here for the benefit of @ref{Archive file names}. If you want to use @acronym{GVFS}-based @option{ftp} or @option{smb} methods, you must add them to @code{tramp-gvfs-methods}, and you must @@ -1642,7 +1665,7 @@ suitable settings. Refer to the Lisp documentation of that variable, accessible with @kbd{C-h v tramp-methods @key{RET}}. In the ELPA archives, there are several examples of such extensions. -They can be installed with Emacs' Package Manager. This includes +They can be installed with Emacs's Package Manager. This includes @table @samp @c @item anything-tramp @@ -2095,8 +2118,8 @@ preserves the path value, which can be used to update shell supports the login argument @samp{-l}. @end defopt -Starting with Emacs 26, @code{tramp-remote-path} can be set per host -via connection-local +Starting with @w{Emacs 26}, @code{tramp-remote-path} can be set per +host via connection-local @ifinfo variables, @xref{Connection Variables, , , emacs}. @end ifinfo @@ -2450,7 +2473,7 @@ where @samp{192.168.0.1} is the remote host IP address Android devices provide a restricted shell access through an USB connection. The local host must have the @command{adb} program installed. Usually, it is sufficient to open the file -@file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via +@file{@trampfn{adb,,/}}. Then you can navigate in the file system via @code{dired}. Alternatively, applications such as @code{Termux} or @code{SSHDroid} @@ -2937,10 +2960,10 @@ Example: @end example During file name completion, remote directory contents are re-read -regularly to account for any changes in the filesystem that may affect -the completion candidates. Such re-reads can account for changes to -the file system by applications outside Emacs (@pxref{Connection -caching}). +regularly to account for any changes in the file system that may +affect the completion candidates. Such re-reads can account for +changes to the file system by applications outside Emacs +(@pxref{Connection caching}). @defopt tramp-completion-reread-directory-timeout The timeout is number of seconds since last remote command for @@ -3161,8 +3184,8 @@ ensures the correct name of the remote shell program. When @code{explicit-shell-file-name} is equal to @code{nil}, calling @code{shell} interactively will prompt for a shell name. -Starting with Emacs 26, you could use connection-local variables for -setting different values of @code{explicit-shell-file-name} for +Starting with @w{Emacs 26}, you could use connection-local variables +for setting different values of @code{explicit-shell-file-name} for different remote hosts. @ifinfo @xref{Connection Variables, , , emacs}. @@ -3231,7 +3254,7 @@ variables. @vindex async-shell-command-width @vindex COLUMNS@r{, environment variable} If Emacs supports the variable @code{async-shell-command-width} (since -Emacs 27.1), @value{tramp} cares about its value for asynchronous +@w{Emacs 27.1}), @value{tramp} cares about its value for asynchronous shell commands. It specifies the number of display columns for command output. For synchronous shell commands, a similar effect can be achieved by adding the environment variable @env{COLUMNS} to @@ -3844,8 +3867,8 @@ Where is the latest @value{tramp}? @item Which systems does it work on? -The package works successfully on Emacs 24, Emacs 25, Emacs 26, and -Emacs 27. +The package works successfully on @w{Emacs 25}, @w{Emacs 26}, @w{Emacs +27}, and @w{Emacs 28}. While Unix and Unix-like systems are the primary remote targets, @value{tramp} has equal success connecting to other platforms, such as @@ -4182,7 +4205,7 @@ Host indication in the mode line? @cindex @value{tramp} theme @vindex tramp-theme-face-remapping-alist -Install @file{tramp-theme} from GNU ELPA via Emacs' Package Manager. +Install @file{tramp-theme} from GNU ELPA via Emacs's Package Manager. Enable it via @kbd{M-x load-theme @key{RET} tramp @key{RET}}. Further customization is explained in user option @code{tramp-theme-face-remapping-alist}. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 478ec7037a8..aabb2f8acc3 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,9 +8,9 @@ @c In the Tramp GIT, the version numbers are auto-frobbed from @c tramp.el, and the bug report address is auto-frobbed from @c configure.ac. -@set trampver 2.4.3.27.1 +@set trampver 2.5.0-pre @set tramp-bug-report-address tramp-devel@@gnu.org -@set emacsver 24.4 +@set emacsver 25.1 @c Other flags from configuration. @set instprefix /usr/local diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi index 9ce809e7d4d..661eb7c947a 100644 --- a/doc/misc/viper.texi +++ b/doc/misc/viper.texi @@ -1752,10 +1752,10 @@ state. If @code{nil}, the cursor stays where it was before the switch. @item viper-always t @code{t} means: leave it to Viper to decide when a buffer must be brought up in Vi state, -Insert state, or Emacs state. This heuristics works well in virtually all -cases. @code{nil} means you either has to invoke @code{viper-mode} manually +Insert state, or Emacs state. This heuristic works well in virtually all +cases. @code{nil} means you either have to invoke @code{viper-mode} manually for each buffer (or you can add @code{viper-mode} to the appropriate major mode -hooks using @code{viper-load-hook}). +hooks using @code{with-eval-after-load}). This option must be set in your Viper customization file. @item viper-custom-file-name "~/.emacs.d/viper" @@ -1903,9 +1903,6 @@ List of (parameterless) functions called just after entering Replace state @item viper-emacs-state-hook nil List of (parameterless) functions called just after switching from Vi state to Emacs state. -@item viper-load-hook nil -List of (parameterless) functions called just after loading Viper. This is -the last chance to do customization before Viper is up and running. @end table @noindent You can reset some of these constants in Viper with the Ex command @kbd{:set} @@ -6,10 +6,10 @@ See the end of the file for license conditions. Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. If possible, use 'M-x report-emacs-bug'. -This file is about changes in Emacs version 27. +This file is about changes in Emacs version 28. See file HISTORY for a list of GNU Emacs versions and release dates. -See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes +See files NEWS.27, NEWS.26, ..., NEWS.18, and NEWS.1-17 for changes in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' @@ -22,3651 +22,184 @@ When you add a new item, use the appropriate mark if you are sure it applies, and please also update docstrings as needed. -* Installation Changes in Emacs 27.1 +* Installation Changes in Emacs 28.1 ---- -** Emacs now uses GMP, the GNU Multiple Precision library. -By default, if 'configure' does not find a suitable libgmp, it -arranges for the included mini-gmp library to be built and used. -The new 'configure' option '--without-libgmp' uses mini-gmp even if a -suitable libgmp is available. - ---- -** Emacs can now use HarfBuzz as its shaping engine. -The new configure option '--with-harfbuzz' adds support for the -HarfBuzz text shaping engine. It is on by default; use './configure ---without-harfbuzz' to build without it. The HarfBuzz text shaping is -available via new font backend drivers 'xfthb' and 'ftcrhb' for Xft -and Cairo drawings, respectively, and via the 'harfbuzz' backend on -MS-Windows. The HarfBuzz text shaping is preferred to the previously -supported ones, so the font backends that use older shaping engines -(FLT on GNU and Unix systems and Uniscribe on MS-Windows) are not -enabled by default; they can be enabled via the 'font-backend' frame -parameter or via X resources. - ---- -** The new configure option '--with-json' adds native support for JSON. -This uses the Jansson library. The option is on by default; use -'./configure --with-json=no' to build without Jansson support. The -new JSON functions 'json-serialize', 'json-insert', -'json-parse-string', and 'json-parse-buffer' are typically much faster -than their Lisp counterparts from json.el. - ---- -** The configure option '--with-cairo' is no longer experimental. -This builds Emacs with Cairo drawing, and supports built-in printing -when Emacs is built with GTK+. Some severe bugs in this build were -fixed, and we can therefore offer this to users without caveats. Note -that building with Cairo enabled results in using Pango instead of -libXft for font support, and that Pango 1.44 has removed support for -bitmapped fonts. - -+++ -** Emacs now uses a "portable dumper" instead of unexec. -This improves compatibility with memory allocation on modern systems, -and in particular better supports the Address Space Layout -Randomization (ASLR) feature, a security technique used by most modern -operating systems. - -When built with the portable dumping support (which is the default), -Emacs looks for the "emacs.pdmp" file, generated during the build, in -its data directory at startup, and loads the dumped state from there. -The new command-line argument '--dump-file=FILE' allows specifying a -non-default ".pdmp" file to load the state from; see the node -"(emacs) Initial Options" in the Emacs manual for more information. +** Cairo graphics library is now used by default if found. +'--with-cairo' is now the default, if the appropriate development files +are found by 'configure'. Note that building with Cairo means using +Pango instead of libXFT for font support. Since Pango 1.44 has +removed support for bitmapped fonts, this may require you to adjust +your font settings. -An Emacs started via a dump file can create a new dump file only if it -was invoked with the '-batch' option. (This is a temporary -limitation; we plan on lifting it in a future release.) - -Although the portable dumper has been tested, it may have a bug on -unusual platforms. If you require traditional unexec dumping you can -use the configure-time option '--with-dumping=unexec'; however, please -file a bug report describing the situation, as unexec dumping is -deprecated, and we plan on removing it in some future release. - ---- -** The new configure option '--enable-checking=structs' attempts to -check that the portable dumper code has been updated to match the last -change to one of the data structures that it relies on. - ---- -** The configure options '--enable-checking=conslist' and -'--enable-checking=xmallocoverrun' have been withdrawn. The former -made Emacs irredeemably slow, and the latter made it crash. Neither -option was useful with modern debugging tools such as AddressSanitizer. -(See "etc/DEBUG" for the details of using the modern replacements of the -removed configure options.) +Note also that 'FontBackend' settings in ".Xdefaults" or +".Xresources", or 'font-backend' frame parameter settings in your init +files, may need to be adjusted, as 'xft' is no longer a valid backend +when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz +text shaping support, and 'ftcr' otherwise. You can determine this by +checking 'system-configuration-features'. The 'ftcr' backend will +still be available when HarfBuzz is supported, but will not be used by +default. We strongly recommend building with HarBuzz support. 'x' is +still a valid backend. --- -** Emacs no longer defaults to using ImageMagick to display images. -This is due to security and stability concerns with ImageMagick. To -override the default, use 'configure --with-imagemagick'. +** 'configure' now warns about building with libXft support. +libXft is unmaintained, and causes a number of problems with modern +fonts including but not limited to crashes; support for it may be +removed in a future version of Emacs. Please consider using +Cairo + HarfBuzz instead. --- -** Several configure options now accept an option-argument 'ifavailable'. -For example, './configure --with-xpm=ifavailable' now configures Emacs -to attempt to use libxpm but to continue building even if libxpm is -absent. The other affected options are '--with-gif', '--with-gnutls', -'--with-jpeg', '--with-png', and '--with-tiff'. +** 'configure' now warns about not using HarfBuzz if using Cairo. +We want to encourage people to use the most modern font features +available, and this is the Cairo graphics library + HarfBuzz for font +shaping, so 'configure' now recommends that combination. --- -** The 'etags' program now uses the C library's regular expression matcher. -If it's possible, 'etags' will use the regexp matcher from the -system's standard C library, otherwise it will be linked with a -compatible regex substitute. This lets developers maintain Emacs's -own regex code without having to also support other programs. The new -configure option '--without-included-regex' forces 'etags' to use the C -library's regex matcher even if the regex substitute ordinarily would -be used to work around compatibility problems. - ---- -** Emacs has been ported to the '-fcheck-pointer-bounds' option of GCC. -This causes Emacs to check bounds of some arrays addressed by its -internal pointers, which can be helpful when debugging the Emacs -interpreter or modules that it uses. If your platform supports it you -can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2 --mmpx -fcheck-pointer-bounds"' on Intel MPX platforms. - ---- -** Emacs now normally uses a C pointer type instead of a C integer -type to implement Lisp_Object, which is the fundamental machine word -type internal to the Emacs Lisp interpreter. This change aims to -catch typos and supports '-fcheck-pointer-bounds'. The 'configure' -option '--enable-check-lisp-object-type' is therefore no longer as -useful and so is no longer enabled by default in developer builds, -to reduce differences between developer and production builds. - ---- -** The distribution tarball now has test cases; 'make check' runs them. -This is intended mostly to help developers. - ---- -** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3 -builds respectively. - ---- -** New make target 'help' shows a summary of common make targets. - ---- -** Emacs now builds with dynamic module support by default. -Pass '--without-modules' to 'configure' to disable dynamic module -support. - ---- -** The ftx font backend driver is now obsolete and will be removed in -Emacs 28. +** The ftx font backend driver has been removed. +It was declared obsolete in Emacs 27.1. -* Startup Changes in Emacs 27.1 - -+++ -** Emacs can now use the XDG convention for init files. -The 'XDG_CONFIG_HOME' environment variable (which defaults to -"~/.config") specifies the XDG configuration parent directory. Emacs -checks for "init.el" and other configuration files inside the "emacs" -subdirectory of 'XDG_CONFIG_HOME', i.e. "$XDG_CONFIG_HOME/emacs/init.el" - -However, Emacs will still initially look for init files in their -traditional locations if "~/.emacs.d" or "~/.emacs" exist, even if -"$XDG_CONFIG_HOME/emacs" also exists. This means that you must delete -or rename any existing "~/.emacs.d" and "~/.emacs" to enable use of -the XDG directory. - -If "~/.emacs.d" does not exist, and Emacs has decided to use it -(i.e. "$XDG_CONFIG_HOME/emacs" does not exist), Emacs will create it. -Emacs will never create "$XDG_CONFIG_HOME/emacs". - -Whichever directory Emacs decides to use, it will set -'user-emacs-directory' to point to it. - -+++ -** Emacs can now be configured using an early init file. -The file is called "early-init.el", in 'user-emacs-directory'. It is -loaded very early in the startup process: before graphical elements -such as the tool bar are initialized, and before the package manager -is initialized. The primary purpose is to allow customizing how the -package system is initialized given that initialization now happens -before loading the regular init file (see below). - -We recommend against putting any customizations in this file that -don't need to be set up before initializing installed add-on packages, -because the early init file is read too early into the startup -process, and some important parts of the Emacs session, such as -'window-system' and other GUI features, are not yet set up, which could -make some customization fail to work. - -+++ -** Installed packages are now activated *before* loading the init file. -As a result of this change, it is no longer necessary to call -'package-initialize' in your init file. - -Previously, a call to 'package-initialize' was automatically inserted -into the init file when Emacs was started. This call can now safely -be removed. Alternatively, if you want to ensure that your init file -is still compatible with earlier versions of Emacs, change it to: - -(when (< emacs-major-version 27) - (package-initialize)) - -However, if your init file changes the values of 'package-load-list' -or 'package-user-dir', or sets 'package-enable-at-startup' to nil then -it won't work right without some adjustment: -- You can move that code to the early init file (see above), so those - settings apply before Emacs tries to activate the packages. -- You can use the new 'package-quickstart' so activation of packages - does not need to pay attention to 'package-load-list' or - 'package-user-dir' any more. - ---- -** Emacs now notifies systemd when startup finishes or shutdown begins. -Units that are ordered after 'emacs.service' will only be started -after Emacs has finished initialization and is ready for use. -(If your Emacs is installed in a non-standard location and you copied the -emacs.service file to e.g. "~/.config/systemd/user/", you will need to copy -the new version of the file again.) +* Startup Changes in Emacs 28.1 -* Changes in Emacs 27.1 - -+++ -** Emacs now supports resizing and rotating images without ImageMagick. -All modern systems support this feature. (On GNU and Unix systems, -Cairo drawing or the XRender extension to X11 is required for this to -be available; the configure script will test for it and, if found, -enable scaling.) - -The new function 'image-transforms-p' can be used to test whether any -given frame supports these capabilities. - -+++ -** The Network Security Manager now allows more fine-grained control -of what checks to run via the 'network-security-protocol-checks' -user option. - -+++ -** TLS connections have their security tightened by default. -Most of the checks for outdated, believed-to-be-weak TLS algorithms -and ciphers are now switched on by default. (In addition, several new -TLS weaknesses are now warned about.) By default, the NSM will -flag connections using these weak algorithms and ask users whether to -allow them. To get the old behavior back (where certificates are -checked for validity, but no warnings about weak cryptography are -issued), you can either set 'network-security-protocol-checks' to nil, -or adjust the elements in that user option to only happen on the 'high' -security level (assuming you use the 'medium' level). - ---- -** New user option 'nsm-trust-local-network'. -Allows skipping Network Security Manager checks for hosts on your -local subnet(s). It defaults to nil. Usually, there should be no -need to set this non-nil, and doing that risks opening your local -network connections to attacks. So be sure you know what you are -doing before changing the value. - -+++ -** Native GnuTLS connections can now use client certificates. -Previously, this support was only available when using the external -'gnutls-cli' command. Call 'open-network-stream' with -':client-certificate t' to trigger looking up of per-server -certificates via 'auth-source'. - -+++ -** New user option 'network-stream-use-client-certificates'. -When non-nil, 'open-network-stream' performs lookups of client -certificates using 'auth-source' as if ':client-certificate t' were -specified if there is no explicit ':client-certificate' parameter. -Defaults to nil. - -+++ -** 'next/previous-multiframe-window' have been renamed. -The new names are as follows: - - 'next-multiframe-window' -> 'next-window-any-frame' - 'previous-multiframe-window' -> 'previous-window-any-frame' - -The old function names are maintained as aliases for backward -compatibility. - -** emacsclient -+++ -*** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. -The command-line argument '--socket-name' overrides it. -(The same behavior as for the pre-existing 'EMACS_SERVER_FILE' variable.) - -+++ -*** Emacs and emacsclient now default to "$XDG_RUNTIME_DIR/emacs". -This is used as the directory for client/server sockets, if Emacs is -running on a platform or environment that sets the 'XDG_RUNTIME_DIR' -environment variable to indicate where session sockets should go. -To get the old, less-secure behavior, you can set the -'EMACS_SOCKET_NAME' environment variable to an appropriate value. - ---- -*** When run by root, emacsclient no longer connects to non-root sockets. -(Instead you can use Tramp methods to run root commands in a non-root Emacs.) - ---- -** 'xft-ignore-color-fonts' now ignores even more color fonts. -There are color fonts that managed to bypass the existing checks, -causing XFT crashes, they are now filtered out. Setting -'xft-ignore-color-fonts' to nil removes those checks, which might -require setting 'face-ignored-fonts' to filter out problematic fonts. -Known problematic fonts are "Noto Color Emoji" and "Emoji One". - ---- -** The GTK+ font chooser now respects 'face-ignored-fonts'. -When using 'menu-set-font' under GTK3, the available fonts are now -matched against 'face-ignored-fonts'. - ---- -** The GTK+ font chooser now remembers the previously selected settings. -It now remembers the name, size, style, etc. - -+++ -** New user option 'what-cursor-show-names'. -When non-nil, 'what-cursor-position' will show the name of the character -in addition to the decimal/hex/octal representation. Default nil. - -+++ -** New function 'network-lookup-address-info'. -This does IPv4 and/or IPv6 address lookups on hostnames. - -+++ -** 'network-interface-list' can now return IPv4 and IPv6 addresses. -IPv4 and IPv6 addresses are now returned by default if available, -optionally including netmask/broadcast address information. - ---- -** Control of the threshold for using the 'distant-foreground' color. -The threshold for color distance below which the 'distant-foreground' -color of the face will be used instead of the foreground color can now -be controlled via the new variable 'face-near-same-color-threshold'. -The default value is 30000, as the previously hard-coded threshold. - -+++ -** The function 'read-passwd' uses "*" as default character to hide passwords. - -** The function 'read-answer' now accepts not only single character -answers, but also function keys like 'F1', character events such as -'C-M-h', and control characters like 'C-h'. - -** Lexical binding is now used when evaluating interactive Elisp forms. -More specifically, 'lexical-binding' is now used for 'M-:', '--eval', -as well as in 'lisp-interaction-mode' and 'ielm-mode', used in the -"*scratch*" and "*ielm*" buffers. - ---- -** The new user option 'tooltip-resize-echo-area' avoids truncating -tooltip text on GUI frames when tooltips are displayed in the echo -area. Instead, it resizes the echo area as needed to accommodate the -full tool-tip text. - ---- -** Show mode line tooltips only if the corresponding action applies. -Customize the user option 'mode-line-default-help-echo' to restore the -old behavior where the tooltip text is also shown when the -corresponding action does not apply. - -+++ -** New hook 'server-after-make-frame-hook'. -This hook is a convenient place to perform initializations in daemon -mode which require GUI features to be available. One example is -restoration of the previous session using the desktop.el package: put -the call to 'desktop-read' in this hook, if you want the GUI settings -to be restored, or if desktop.el needs to interact with you during -restoration of the session. - -+++ -** The functions 'set-frame-height' and 'set-frame-width' are now -commands, and will set the currently selected frame to the height/ -width specified by the numeric prefix. - -+++ -** New function 'logcount' calculates an integer's Hamming weight. - -+++ -** New function 'libxml-available-p'. -This function returns non-nil if libxml support is both compiled in -and available at run time. Lisp programs should use this function to -detect built-in libxml support, instead of testing for that -indirectly, e.g., by checking that functions like -'libxml-parse-html-region' return nil. - -+++ -** 'libxml-parse-xml-region' and 'libxml-parse-html-region' take -a parameter that's called DISCARD-COMMENTS, but it really only -discards the top-level comment. Therefore this parameter is now -obsolete, and the new utility function 'xml-remove-comments' can be -used to remove comments before calling the libxml functions to parse -the data. - -+++ -** A new DOM (the XML/HTML document structure returned by functions -such as 'libxml-parse-html-region') traversal function has been added: -'dom-search', which takes a DOM and a predicate and returns all nodes -that match. - -+++ -** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. -It blocks line breaking after a one-letter word, also in the case when -this word is preceded by a non-space, but non-alphanumeric character. - -+++ -** The limit on repetitions in regexps has been raised to 2^16-1. -It was previously limited to 2^15-1. For example, the following -regular expression was previously invalid, but is now accepted: - - x\{32768\} - ---- -** The German prefix and postfix input methods now support Capital sharp S. - ---- -** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'. - ---- -** New input methods 'georgian-qwerty' and 'georgian-nuskhuri'. - ---- -** New input methods for several variants of the Sami language. -The Sami input methods include: 'norwegian-sami-prefix', -'bergsland-hasselbrink-sami-prefix', 'southern-sami-prefix', -'ume-sami-prefix', 'northern-sami-prefix', 'inari-sami-prefix', -'skolt-sami-prefix', and 'kildin-sami-prefix'. - -+++ -** Japanese environments use UTF-8 by default. -In Japanese environments that do not specify encodings and are not -based on MS-Windows, the default encoding is now utf-8 instead of -japanese-iso-8bit. - -+++ -** New function 'exec-path'. -This function by default returns the value of the corresponding -user option, but can optionally return the equivalent of 'exec-path' -from a remote host. - -+++ -** The function 'executable-find' supports an optional argument REMOTE. -This triggers searching for the program on the remote host as indicated by -'default-directory'. - -+++ -** New user option 'auto-save-no-message'. -When set to t, no message will be shown when auto-saving (default -value: nil). - ---- -** The value of 'make-cursor-line-fully-visible' can now be a function. -In addition to nil or non-nil, the value can now be a predicate -function. Follow mode uses this to control scrolling of its windows -when the last screen line in a window is not fully visible. - -+++ -** New variable 'emacs-repository-branch'. -It reports the git branch from which Emacs was built. - -+++ -** New user option 'switch-to-buffer-obey-display-actions'. -When non-nil, 'switch-to-buffer' uses 'pop-to-buffer-same-window' that -respects display actions specified by 'display-buffer-alist' and -'display-buffer-overriding-action'. - -+++ -** The user option 'switch-to-visible-buffer' is now obsolete. -Customize 'switch-to-prev-buffer-skip' instead. - -+++ -** New user option 'switch-to-prev-buffer-skip'. -This user option allows specifying the set of buffers that may be -shown by 'switch-to-prev-buffer' and 'switch-to-next-buffer' more -stringently than the now obsolete 'switch-to-visible-buffer'. - -** New 'flex' completion style. -An implementation of popular "flex/fuzzy/scatter" completion which -matches strings where the pattern appears as a subsequence. Put -simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex' -to 'completion-styles' or 'completion-category-overrides' to use it. - -** The 'completion-common-part' face is now visible by default. - -+++ -** New face attribute ':extend' to control face extension at EOL. -The new face attribute ':extend' controls whether to use the face for -displaying the empty space beyond end of line (EOL) till the edge of -the window. By default, this attribute is non-nil only for a small -number of faces, notably, 'region'; any other face that crosses end of -line will not affect the display of the empty space at EOL. This is -to make Emacs behave more like other GUI applications with respect to -displaying faces that cross line boundaries. - -This attribute behaves specially when theme definitions are applied: -if the theme doesn't specify an explicit value of this attribute for a -face, the value from the original face definition is inherited. -Consequently, a theme generally shouldn't specify this attribute -unless it has a good reason to do so. - -** Connection-local variables -+++ -*** Connection-local variables are applied by default like file-local -and directory-local variables. - -+++ -*** The macro 'with-connection-local-variables' has been renamed from -'with-connection-local-profiles'. No argument PROFILES needed any longer. - ---- -** New user option 'next-error-verbose' controls when 'next-error' -outputs a message about the error locus. - ---- -** New user option 'grep-search-path' defines the directories searched for -grep hits (this used to be controlled by 'compilation-search-path'). - ---- -** New user option 'emacs-lisp-compilation-search-path' defines the -directories searched for byte-compiler error messages (this used to -be controlled by 'compilation-search-path'). - ---- -** Multicolor fonts such as "Noto Color Emoji" can be displayed on -Emacs configured with Cairo drawing and linked with cairo >= 1.16.0. - -+++ -** Emacs now optionally displays a fill column indicator. -This is similar to what 'fill-column-indicator' package provides, but -much faster and compatible with 'show-trailing-whitespace'. - -Customize the buffer-local user options 'display-fill-column-indicator' -and 'display-fill-column-indicator-character' to activate the -indicator. - -The indicator is not displayed at all in minibuffer windows and -in tooltips, as it is not useful there. - -There are 2 new buffer local variables and 1 face to customize this -mode, they are described in the manual "(emacs) Display". - -+++ -** 'progress-reporter-update' now accepts an optional suffix string to display. +* Changes in Emacs 28.1 ---- -** New user option 'xref-file-name-display' controls the display of -file names in xref buffers. - -** New user option 'byte-count-to-string-function'. -It is used for displaying file sizes and disk space in some cases. - -+++ -** Emacs now interprets RGB triplets like HTML, SVG, and CSS do. -The X convention previously used differed slightly, particularly for -RGB triplets with a single hexadecimal digit per component. - ---- -** The toolbar now shows the equivalent key binding in its tooltips. - ---- -** The File menu-bar menu was re-arranged. -Print menu items moved to submenu, and also added the new entries for tabs. - ---- -** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally. -Note that this key binding will not work on MS-Windows systems if -'w32-scroll-lock-modifier' is non-nil. - ---- -** 'global-set-key', called interactively, now no longer downcases a -key binding with an upper case letter - if you can type it, you can -bind it. - -+++ -** 'read-from-minibuffer' now works with buffer-local history variables. -The HIST argument of 'read-from-minibuffer' now works correctly with -buffer-local variables. This means that different buffers can have -their own separated input history list if desired. - -** 'backup-by-copying-when-privileged-mismatch' applies to file gid, too. -In addition to checking the file owner uid, Emacs also checks that the -group gid is not greater than 'backup-by-copying-when-privileged-mismatch'; -if so, 'backup-by-copying-when-mismatch' will be forced on. +** Support for '(box . SIZE)' cursor-type. +By default, 'box' cursor always has a filled box shape. But if you +specify cursor-type to be '(box . SIZE)', the cursor becomes a hollow +box if the point is on an image larger than 'SIZE' pixels in any +dimension. -* Editing Changes in Emacs 27.1 - -+++ -** When asked to visit a large file, Emacs now offers to visit it literally. -Previously, Emacs would only ask for confirmation before visiting -large files. Now it also offers a third alternative: to visit the -file literally, as in 'find-file-literally', which speeds up -navigation and editing of large files. - -+++ -** 'zap-to-char' now uses the history of characters you used to zap to. -'zap-to-char' uses the new 'read-char-from-minibuffer' function to allow -navigating through the history of characters that have been input. -This is mostly useful for characters that have complex input methods -where inputting the character again may involve many keystrokes. - -+++ -** 'save-some-buffers' now has a new action in the prompt: 'C-f' will -exit the command and switch to the buffer currently being asked about. - ---- -** More commands support noncontiguous rectangular regions, namely -'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region', -'upcase-initials-region', 'replace-string', 'replace-regexp', and -'delimit-columns-region'. - -+++ -** The new 'amalgamating-undo-limit' variable can be used to control -how many changes should be amalgamated when using the 'undo' command. - ---- -** The 'newline-and-indent' command (commonly bound to 'RET' in many -modes) now takes an optional numeric argument to specify how many -times is should insert newlines (and indent). - -+++ -** New command 'make-empty-file'. - ---- -** New variable 'x-wait-for-event-timeout'. -This controls how long Emacs will wait for updates to the graphical -state to take effect (making a frame visible, for example). - -+++ -** New user option 'electric-quote-replace-double'. -This option controls whether '"' is replaced in 'electric-quote-mode', -in addition to other quote characters. If non-nil, ASCII double-quote -characters that quote text "like this" are replaced by double -typographic quotes, “like thisâ€, in text modes, and in comments in -non-text modes. - ---- -** New user option 'flyspell-case-fold-duplications'. -This option controls whether Flyspell mode considers consecutive words -to be duplicates if they are not in the same case. If non-nil, the -default, words are considered to be duplicates even if their letters' -case does not match. - ---- -** 'write-abbrev-file' now includes special properties. -'write-abbrev-file' now writes special properties like ':case-fixed' -for abbrevs that have them. - -+++ -** 'write-abbrev-file' skips empty tables. -'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for -tables which do not have any non-system abbrevs to save. +* Editing Changes in Emacs 28.1 +++ -** The new functions and commands 'text-property-search-forward' and -'text-property-search-backward' have been added. These provide an -interface that's more like functions like 'search-forward'. - ---- -** 'add-dir-local-variable' now uses dotted pair notation syntax to -write alists of variables to ".dir-locals.el". This is the same -syntax that you can see in the example of a ".dir-locals.el" file in -the node "(emacs) Directory Variables" of the user manual. - -+++ -** Network connections using 'local' can now use IPv6. -'make-network-process' now uses the correct loopback address when -asked to use ':host 'local' and ':family 'ipv6'. - -+++ -** The new function 'replace-region-contents' replaces the current -region using a given replacement-function in a non-destructive manner -(in terms of 'replace-buffer-contents'). - -+++ -** The command 'replace-buffer-contents' now has two optional -arguments mitigating performance issues when operating on huge -buffers. +** New command 'undo-redo'. +It undoes previous undo commands, but doesn't record itself as an +undoable command. +++ -** Dragging 'C-M-mouse-1' now marks rectangular regions. +** 'read-number' now has its own history variable. +Additionally, the function now accepts a HIST argument which can be +used to specify a custom history variable. +++ -** The command 'delete-indentation' now operates on the active region. -If the region is active, the command joins all the lines in the -region. When there's no active region, the command works on the -current and the previous or the next line, as before. +** Input history for 'goto-line' is now local to every buffer. +Each buffer will keep a separate history of line numbers used with +'goto-line'. This should help making faster the process of finding +line numbers that were previously jumped to. +++ -** You can now change the font size with the mouse wheel. -Scrolling the mouse wheel with the Ctrl key pressed will now act the -same as the 'C-x C-+' and 'C-x C--' commands. +** When 'suggest-key-bindings' is non-nil, the completion list of 'M-x' +shows equivalent key bindings for all commands that have them. -* Changes in Specialized Modes and Packages in Emacs 27.1 - ---- -** New HTML mode skeleton 'html-id-anchor'. -This new command (which inserts an <a id="foo">_</a> skeleton) is -bound to 'C-c C-c #'. - -+++ -** New command 'font-lock-refontify'. -This is an interactive convenience function to be used when developing -font locking for a mode. It recomputes the font locking data and then -re-fontifies the buffer. - ---- -** Font Lock is smarter about fontifying unterminated strings and comments. -When you type a quote that starts a string, or a comment delimiter -that starts a comment, font-lock will not immediately refontify the -following characters in 'font-lock-string-face' or -'font-lock-comment-face'. Instead, it will delay the fontification -beyond the current line to give you a chance to close the string or -comment. This is controlled by the new user option -'jit-lock-antiblink-grace', which specifies the delay in seconds. The -default is 2 seconds; set to nil to get back the old behavior. - ---- -** The 'C' command in 'tar-mode' will now preserve the timestamp of -the extracted file if the new user option 'tar-copy-preserve-time' is -non-nil. - ---- -** 'autoconf-mode' is now used instead of 'm4-mode' for the -"acinclude.m4" / "aclocal.m4" / "acsite.m4" files. - ---- -** On GNU/Linux, 'M-x battery' will now list all batteries, no matter -what they're named, and the 'battery-linux-sysfs-regexp' variable has -been removed. - -** The 'list-processes' command now includes port numbers in the -network connection information (in addition to the host name). - -** The 'cl' package is now officially deprecated in favor of 'cl-lib'. - ---- -** desktop - -*** When called interactively with a prefix arg 'C-u', 'desktop-read' -now prompts the user for the directory containing the desktop file. - -+++ -** display-line-numbers-mode - -*** New faces 'line-number-major-tick' and 'line-number-minor-tick', -and user options 'display-line-numbers-major-tick' and -'display-line-numbers-minor-tick' can be used to highlight the line -numbers of lines multiple of certain numbers. - -*** New variable 'display-line-numbers-offset', when non-zero, adds -an offset to absolute line numbers. - -+++ -** winner - -*** A new user option, 'winner-boring-buffers-regexp', has been added. - -** table - -*** 'table-generate-source' and friends now support outputting wiki and -mediawiki format tables. - ---- -** telnet-mode - -*** Reverting a buffer in 'telnet-mode' will restart a closed connection. - -** goto-addr - -*** A way to more conveniently specify what URI address schemes should -be ignored has been added via the 'goto-address-uri-schemes-ignored' -variable. - -+++ -** tex-mode - -*** 'latex-noindent-commands' controls indentation of certain commands. -You can use this new user option to control indentation of arguments of -\emph, \footnote, and similar commands. - -** byte compiler - -*** 'byte-compile-dynamic' is now obsolete. -This is because on the one hand it suffers from misbehavior in corner -cases that have plagued it for years, and on the other experiments indicated -that it doesn't bring any measurable benefit. - ---- -*** The 'g' keystroke in "*Compile-Log*" buffers has been bound to a -new command that will recompile the file previously compiled with 'M-x -byte-compile-file' and the like. - -** compile.el - ---- -*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can -be functions. - -+++ -*** 'compilation-context-lines' can now take the value t; this is like -nil, but instead of scrolling the current line to the top of the -screen when there is no left fringe, it inserts a visible arrow before -column zero. - ---- -*** The new 'compilation-transform-file-match-alist' user option can -be used to transform file name matches compilation output, and remove -known false positives being recognized as warnings/errors. - -** cl-lib.el - -+++ -*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining -its functions. - -+++ -*** 'cl-defstruct' slots accept a ':documentation' property. - ---- -*** 'cl-values-list' will now signal an error if its argument isn't a list. - -** doc-view.el - -*** New commands 'doc-view-presentation' and 'doc-view-fit-window-to-page'. - -*** Added support for password-protected PDF files. - -*** A new user option 'doc-view-pdftotext-program-args' has been added -to allow controlling how the conversion to text is done. - -** Ido - -*** New user option 'ido-big-directories' to mark directories whose -names match certain regular expressions as big. Ido won't attempt to -list the contents of such directories when completing file names. - -** Minibuffer - -+++ -*** A new user option, 'minibuffer-beginning-of-buffer-movement', has -been introduced to allow controlling how the 'M-<' command works in -the minibuffer. If non-nil, point will move to the end of the prompt -(if point is after the end of the prompt). - -+++ -*** When the minibuffer is active, echo-area messages are displayed at -the end of the minibuffer instead of hiding the minibuffer by the echo -area display. The new user option 'minibuffer-message-clear-timeout' -controls how messages displayed in this situation are removed from the -minibuffer. - ---- -*** Minibuffer now uses 'minibuffer-message' to display error messages -at the end of the active minibuffer. - -+++ -*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer. - ---- -*** Some commands that previously used 'read-char-choice' now read -a character using the minibuffer by 'read-char-from-minibuffer'. - -** map.el - -*** Now also understands plists. -*** Now defined via generic functions that can be extended via 'cl-defmethod'. -*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function. -*** 'map-contains-key' now returns a boolean rather than the key. -*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'. -*** New generic function 'map-insert'. -+++ -*** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'. - -** seq.el -New convenience functions 'seq-first' and 'seq-rest' give easy access -to respectively the first and all but the first elements of sequences. - -The new predicate function 'seq-contains-p' should be used instead of -the now obsolete 'seq-contains'. - ---- -** Follow mode -In the current follow group of windows, "ghost" cursors are no longer -displayed in the non-selected follow windows. To get the old behavior -back, customize 'follow-hide-ghost-cursors' to nil. - -+++ -** New variable 'warning-fill-column' for 'display-warning'. - -** Windmove - ---- -*** 'windmove-create-window' when non-nil makes a new window. -This happens upon moving off the edge of the frame. - ---- -*** Windmove supports directional window display and selection. -The new command 'windmove-display-default-keybindings' binds default -keys with provided modifiers (by default, Shift-Meta) to the commands -that display the next buffer in the window at the specified direction. -This is like 'windmove-default-keybindings' that binds keys to commands -that select the window in the specified direction, but additionally it -displays the buffer from the next command in that window. For example, -'S-M-right C-h i' displays the "*Info*" buffer in the right window, -creating the window if necessary. A special key can be customized to -display the buffer in the same window, for example, 'S-M-0 C-h e' -displays the "*Messages*" buffer in the same window. 'S-M-t C-h C-n' -displays NEWS in a new tab. - ---- -*** Windmove also supports directional window deletion. -The new command 'windmove-delete-default-keybindings' binds default -keys with provided prefix (by default, 'C-x') and modifiers (by default, -'Shift') to the commands that delete the window in the specified -direction. For example, 'C-x S-down' deletes the window below. -With a prefix arg 'C-u', also kills the buffer in that window. -With 'M-0', deletes the selected window and selects the window -that was in the specified direction. - ---- -*** New command 'windmove-swap-states-in-direction' binds default keys -to the commands that swap the states of the selected window with the -window in the specified direction. - ---- -*** Windmove code no longer used is now obsolete. -That includes the user option 'windmove-window-distance-delta' and the -functions 'windmove-coord-add', 'windmove-constrain-to-range', -'windmove-constrain-around-range', 'windmove-frame-edges', -'windmove-constrain-loc-for-movement', 'windmove-wrap-loc-for-movement', -'windmove-reference-loc' and 'windmove-other-window-loc'. - -** Octave mode -The mode is automatically enabled in files that start with the -'function' keyword. - -** project.el - -*** New commands 'project-search' and 'project-query-replace-regexp'. -*** New user option 'project-read-file-name-function'. - -** Etags - -+++ -*** 'next-file' is now an obsolete alias of 'tags-next-file'. - ---- -*** 'tags-loop-revert-buffers' is an obsolete alias of -'fileloop-revert-buffers'. - -+++ -*** The 'tags-loop-continue' function along with the -'tags-loop-operate' and 'tags-loop-scan' variables are now obsolete; -use the new 'fileloop-initialize' and 'fileloop-continue' functions -instead. - -+++ -*** etags is now able to read Zstandard-compressed files. - -** bibtex - ---- -*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'. -In 'bibtex-mode-map', 'forward-paragraph' and 'backward-paragraph' are -remapped to these, respectively. +* Changes in Specialized Modes and Packages in Emacs 28.1 ** Dired ---- -*** On systems that support suid/guid files, Dired now fontifies the -permissions of such files with a special face 'dired-set-id'. - -+++ -*** New command 'dired-create-empty-file'. - -+++ -*** New command 'dired-number-of-marked-files'. -It is by default bound to '* N'. - ---- -*** The marking commands now report how many files were marked by the -command itself, not how many files are marked in total. - ---- -*** A new face, 'dired-special', is used to highlight sockets, named -pipes, block devices and character devices. - -+++ -*** The new user option 'dired-create-destination-dirs' controls whether -'dired-do-copy' and 'dired-rename-file' should create non-existent -directories in the destination. - -+++ -*** 'dired-dwim-target' can be customized to prefer either the next window, -or one of the most recently visited windows with a Dired buffer. - -+++ -*** When the new user option 'dired-vc-rename-file' is non-nil, -Dired performs file renaming using underlying version control system. - ---- -*** Zstandard compression is now supported for 'dired-do-compress' and -'dired-do-compress-to'. - -** Find-Dired - ---- -*** New user option 'find-dired-refine-function'. -The default value is 'find-dired-sort-by-filename'. - ---- -*** New sorting options for the user option 'find-ls-option'. - -** Change Logs and VC - ---- -*** New user option 'vc-tor'. -When non-nil, this user option causes the VC commands to communicate -with the repository via Tor's proxy, using the 'torsocks' wrapper -script. The default is nil. - -+++ -*** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'. -This generates ChangeLog entries from the VC fileset diff. - ---- -*** 'vc-dir' now shows a button allowing you to hide the stash list. -Controlled by user option 'vc-git-show-stash'. Default t means show -the entire list as before. An integer value limits the list length -(but still allows you to show the entire list via the button). - -+++ -*** Recording ChangeLog entries doesn't require an actual file. -If a ChangeLog file doesn't exist, and if the new user option -'add-log-dont-create-changelog-file' is non-nil (which is the -default), commands such as 'C-x 4 a' will add log entries to a -suitable named temporary buffer. (An existing ChangeLog file will -still be used if it exists.) Set the user option to nil to get the -previous behavior of always creating a buffer that visits a ChangeLog -file. - ---- -*** New user option 'vc-find-revision-no-save'. -With non-nil, 'vc-find-revision' doesn't write the created buffer to file. - ---- -*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked files. - ---- -*** New user option 'vc-git-grep-template'. -This new user option allows customizing the default arguments passed to -'git-grep' when 'vc-git-grep' is used. - ---- -*** Command 'vc-git-stash' now respects marks in the "*vc-dir*" buffer. -When some files are marked, only those are stashed. -When no files are marked, all modified files are stashed, as before. - ---- -*** 'vc-git-stash' is now bound to 'C' in the stash headers. - --- -*** Some stash keybindings are now available in the stash button. -'vc-git-stash' and 'vc-git-stash-snapshot' can now be run using 'C' -and 'S' respectively, including when there are no stashes. - ---- -*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. - ---- -*** 'vc-hg' now invokes 'smerge-mode' when visiting files. -Code that attempted to invoke 'smerge-mode' when visiting an Hg file -with conflicts existed in earlier versions of Emacs, but incorrectly -never detected a conflict due to invalid assumptions about cached -values. - -+++ -*** The Hg (Mercurial) back-end now supports 'vc-region-history'. -The 'C-x v h' command now works in buffers that visit files controlled -by Hg. - -+++ -*** The Hg (Mercurial) back-end now prompts for revision to merge when -you invoke 'C-x v m' ('vc-merge'). - ---- -*** The Hg (Mercurial) back-end now uses tags, branches and bookmarks -instead of revision numbers as completion candidates when it prompts -for a revision. - -+++ -*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions -and compares their entire trees. - -*** New user option 'vc-hg-revert-switches'. -It specifies switches to pass to Hg's 'revert' command. - -*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase') -print diffs and logs between the merge base (common ancestor) of two -given revisions. - -+++ -*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode' -buffers will delete the marked files (or if no files are marked, the -file under point). This command does not notify the VC backend, and -is mostly useful for unregistered files. - -+++ -*** New command 'vc-log-search' asks for a pattern, searches it -in the revision log, and displays matched log entries in the -log buffer. For example, 'M-x vc-log-search RET bug#36644 RET' -displays all entries whose log messages match the bug number. -With a prefix argument asks for a command, so for example, -'C-u M-x vc-log-search RET git log -1 f302475 RET' will display -just one log entry found by its revision number. - -+++ -*** It is now possible to display a specific revision given by its ID. -If you invoke 'C-x v L' ('vc-print-root-log') with a numeric argument -of 1, as in 'C-1 C-x v L' or 'C-u 1 C-x v L', it asks for a revision -ID, and shows its log entry together with the diffs introduced by the -revision's commit. (For some less capable VCSes, only the log entry -is shown.) - ---- -*** 'C-x v =' can now mimic Magit's diff format. -Set the new user option 'diff-font-lock-prettify' to t for that, see -below under "Diff mode". - ---- -*** The 'diff' function arguments OLD and NEW may each be a buffer -rather than a file, in non-interactive calls. This change was made in -Emacs 24.1, but wasn't documented until now. - -+++ -*** New command 'diff-buffers' interactively diffs two buffers. - -** Diff mode - -+++ -*** Hunks are now automatically refined by font-lock. -To disable refinement, set the new user option 'diff-refine' to nil. -To get back the old behavior where hunks are refined as you navigate -through a diff, set 'diff-refine' to the symbol 'navigate'. - -+++ -*** 'diff-auto-refine-mode' is deprecated in favor of 'diff-refine'. -It is no longer enabled by default and binding it no longer has any -effect. - -+++ -*** Better syntax highlighting of Diff hunks. -Fragments of source in Diff hunks are now by default highlighted -according to the appropriate major mode. Customize the new user -option 'diff-font-lock-syntax' to nil to disable this. - ---- -*** File headers can be shortened, mimicking Magit's diff format. -To enable it, set the new user option 'diff-font-lock-prettify' to t. -On GUI frames, this option also displays the insertion and deletion -indicators on the left fringe. - -+++ -*** Prefix arg of 'diff-goto-source' means jump to the old revision -of the file under version control if point is on an old changed line, -or to the new revision of the file otherwise. - -** Texinfo - -+++ -*** New function for inserting '@pxref', '@xref', or '@ref' commands. -The function 'texinfo-insert-dwim-@ref', bound to 'C-c C-c r' by -default, inserts one of three types of references based on the text -surrounding point, namely '@pxref' near a parenthesis, '@xref' at the -start of a sentence or at '(point-min)', else '@ref'. - -** Browse-url - ---- -*** The function 'browse-url-emacs' can now visit a URL in selected window. -It now treats the optional 2nd argument to mean that the URL should be -shown in the currently selected window. - ---- -*** A new function, 'browse-url-add-buttons' can be used to add clickable -links to most ordinary special-mode buffers that display text that -have URLs embedded. 'browse-url-button-regexp' controls what's -considered a button. - ---- -*** New user option 'browse-url-secondary-browser-function'. -It can be set to a function that invokes an alternative browser. - -** Comint - -+++ -*** 'send-invisible' is now an obsolete alias for 'comint-send-invisible'. -Also, 'shell-strip-ctrl-m' is declared obsolete. - -+++ -*** 'C-c .' ('comint-insert-previous-argument') no longer interprets '&'. -This feature caused problems when '&&' was present in the previous -command. Since this command emulates 'M-.' in Bash and zsh, neither -of which treats '&' specially, the feature was removed for -compatibility with these shells. - -+++ -*** 'comint-insert-previous-argument' can now count arguments from the end. -By default, invoking 'C-c .' with a numeric argument N would copy the -Nth argument, counting from the first one. But if the new user option -'comint-insert-previous-argument-from-end' is non-nil, it will copy -the Nth argument counting from the last one. Thus 'C-c .' can now -better emulate 'M-.' in both Bash and zsh, since the former counts -from the beginning of the arguments, while the latter counts from the -end. - -+++ -*** 'comint-run' can now accept a list of switches to pass to the program. -'C-u M-x comint-run' will prompt for the switches interactively. - -+++ -*** Abnormal hook 'comint-password-function' has been added. -This hook permits a derived mode to supply a password for the -underlying command interpreter without prompting the user. For -example, in 'sql-mode', the password for connecting to the database may -be stored in the connection wallet and may be passed on the command -line to start the SQL interpreter. This is a potential security flaw -that could expose user's database passwords on the command line -through the use of a process list (Bug#8427). With this hook, it is -possible to not pass the password on the command line and wait for the -program to prompt for the password. When it does so, the password can -be supplied to the SQL interpreter without involving the user just as -if it had been supplied on the command line. - -** SQL - ---- -*** SQL Indent Minor Mode -SQL Mode now supports the ELPA 'sql-indent' package for assisting -sophisticated SQL indenting rules. Note, however, that SQL is not -like other programming languages like C, Java, or Python where code is -sparse and rules for formatting are fairly well established. Instead -SQL is more like COBOL (from which it came) and code tends to be very -dense and line ending decisions driven by syntax and line length -considerations to make readable code. Experienced SQL developers may -prefer to rely upon existing Emacs facilities for formatting code but -the 'sql-indent' package provides facilities to aid more casual SQL -developers layout queries and complex expressions. - ---- -**** 'sql-use-indent-support' (default t) enables SQL indention support. -The 'sql-indent' package from ELPA must be installed to get the -indentation support in 'sql-mode' and 'sql-interactive-mode'. - ---- -**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. -Both hook variables have had 'sql-indent-enable' added to their -default values. If you have existing customizations to these -variables, you should make sure that the new default entry is -included. - ---- -*** Connection Wallet -Database passwords can now by stored in NETRC or JSON data files that -may optionally be encrypted. When establishing an interactive session -with the database via 'sql-connect' or a product specific function, -like 'sql-mysql' or 'sql-postgres', the password wallet will be -searched for the password. The 'sql-product', 'sql-server', -'sql-database', and the 'sql-username' will be used to identify the -appropriate authorization. This eliminates the discouraged practice of -embedding database passwords in your Emacs initialization. - -See the 'auth-source' module for complete documentation on the file -formats. By default, the wallet file is expected to be in the -'user-emacs-directory', named "sql-wallet" or ".sql-wallet", with -".json" (JSON) or no (NETRC) suffix. Both file formats can optionally -be encrypted with GPG by adding an additional ".gpg" suffix. - -** Term - ---- -*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead. - -+++ -*** 'serial-term' now takes an optional parameter to leave the -emulator in line mode. - -** Flymake - -+++ -*** The variable 'flymake-diagnostic-types-alist' is obsolete. -You should instead set properties on known diagnostic symbols, like -':error' and ':warning', as demonstrated in the Flymake manual. - -+++ -*** New user option 'flymake-start-on-save-buffer'. -Control whether Flymake starts checking the buffer on save. - ---- -*** Flymake and backend functions may exchange hints about buffer changes. -This enables more efficient backends. See the docstring of -'flymake-diagnostic-functions' or the Flymake manual for details. - -+++ -*** 'flymake-start-syntax-check-on-newline' is now obsolete, -use 'post-self-insert-hook' to check on newline. - -** Ruby - ---- -*** The Rubocop Flymake diagnostic function will only run Lint cops if -it can't find the config file. - ---- -*** Rubocop is called with 'bundle exec' if Gemfile mentions it. - ---- -*** New command 'ruby-find-library-file' bound to 'C-c C-f'. - -** Package - ---- -*** Warn if "footer line" is missing, but still install package. -package.el used to refuse to install a package without the so-called -"footer line", which appears at the very end of the file: - -;;; FILENAME ends here - -package.el will now install packages without this line, but it will -issue a warning. To avoid this warning, packages should keep the -"footer line". - -Note that versions of Emacs older than 27.1 will not only refuse to -install packages without such a line -- they will be unable to parse -package data. It is therefore recommended to keep this line. - -+++ -*** Change of 'package-check-signature' for packages with multiple sigs. -In previous Emacsen, t checked that all signatures are valid. -Now t only checks that at least one signature is valid and the new 'all' -value needs to be used if you want to enforce that all signatures -are valid. This only affects packages with multiple signatures. - -+++ -*** The meaning of 'allow-unsigned' in 'package-check-signature' has -changed slightly: If a usable OpenPGP configuration can't be found -(for instance, if gpg isn't installed), it now has the same meaning as -nil. - ---- -*** New function 'package-get-version' lets packages query their own version. -Example use in auctex.el: '(defconst auctex-version (package-get-version))' - ---- -*** New 'package-quickstart' feature. -When 'package-quickstart' is non-nil, package.el precomputes a big -autoloads file so that activation of packages can be done much faster, -which can speed up your startup significantly. -It also causes user options like 'package-user-dir' and -'package-load-list' to be consulted when 'package-quickstart-refresh' -is run rather than at startup so you don't need to set them in your -early init file. - ---- -*** New function 'package-activate-all'. - -+++ -*** New functions for filtering packages list. -A new function has been added which allows users to filter the -packages list by name: 'package-menu-filter-by-name'. By default, it -is bound to '/ n'. Additionally, the function -'package-menu-filter-by-keyword' has been renamed from -'package-menu-filter'. Its keybinding has also been changed to '/ k' -(from 'f'). To clear any of the two filters, the user can now call -the 'package-menu-clear-filter' function, bound to '/ /' by default. - ---- -*** Imenu support has been added to 'package-menu-mode'. - ---- -*** The package list can now be sorted by version or description. - -+++ -*** In Package Menu, 'g' now updates package data from archives. -Previously, 'g' invoked 'tabulated-list-revert' which did not update -the cached archive data. It is now bound to 'revert-buffer', which -will update the data. - -'package-menu-refresh' is an obsolete alias for 'revert-buffer'. - -** Info - -+++ -*** Clicking on the left/right arrow icon in the Info tool-bar while -holding down the Ctrl key pops up a menu of previously visited Info nodes -where you can select a node to go back (like in browsers). - ---- -*** Info can now follow 'file://' protocol URLs. -The 'file://' URLs in Info documents can now be followed by passing -them to the 'browse-url' function, like the other protocols: 'ftp', -'http', and 'https'. This allows having references to local HTML -files, for example. - ---- -** Display of man pages now limits the width for formatting pages. -The new user option 'Man-width-max' (80 by default) limits the number -of columns passed to the 'man' program for formatting man pages. This -is to enhance readability when man pages are displayed in very wide -windows (which are customary with today's large displays). - -** Xref - -+++ -*** New command 'xref-find-definitions-at-mouse'. -This command finds definitions of the identifier at the place of a -mouse click event, and is intended to be bound to a mouse event. - -+++ -*** Changing 'xref-marker-ring-length' works after xref.el is loaded. -Previously, setting 'xref-marker-ring-length' would only take effect -if set before xref.el was loaded. - ---- -*** 'xref-find-definitions' now sets the mark at the buffer position -where it was invoked. - ---- -*** New xref faces 'xref-file-header', 'xref-line-number', 'xref-match'. - ---- -*** New user option 'xref-show-definitions-function'. -It encapsulates the logic pertinent to showing the result of -'xref-find-definitions'. The user can change it to customize its -behavior and the display of results. - ---- -*** Search results show the buffer even for one hit. -The search-type Xref commands (e.g. 'xref-find-references' or -'project-find-regexp') now show the results buffer even when there is -only one hit. This can be altered by changing 'xref-show-xrefs-function'. - -+++ -*** Xref buffers support refreshing the search results. -A new command 'xref-revert-buffer' is bound to 'g'. - ---- -*** Imenu support has been added to 'xref--xref-buffer-mode'. - -*** New generic method 'xref-backend-identifier-completion-ignore-case'. -Using it, the etags backend now honors 'tags-case-fold-search' during -identifier completion. - -** Checkdoc - ---- -*** Checkdoc can now optionally spell-check doc strings. -Invoking 'checkdoc-buffer' with a non-nil TAKE-NOTES argument -(interactively, with a prefix arg) will now spell-check the doc -strings and report all the spelling mistakes. - -** Icomplete - -+++ -*** New minor mode Fido mode. -This mode is based on Icomplete, and its name stands for "Fake Ido". -The point of this mode is to be an 'ido-mode' workalike, but provide -most of the functionality present in Icomplete that is not in -'ido-mode', while being much more compatible with all of Emacs's -completion facilities. - -** Ecomplete - ---- -*** The Ecomplete sorting has changed to a decay-based algorithm. -This can be controlled by the new 'ecomplete-sort-predicate' user option. - ---- -*** The 'ecomplete-database-file' file is now placed in -"~/.emacs.d/ecompleterc" by default. Of course it will still find it -if you have it in "~/.ecompleterc". - -** Gnus - ---- -*** 'mm-uu-diff-groups-regexp' now defaults to matching all groups, -which means that "git am" diffs are recognized everywhere. - -+++ -*** Two new Gnus summary mode navigation commands have been added, -bound to the '[' and ']' keys: 'gnus-summary-prev-unseen-article' and -'gnus-summary-next-unseen-article'. These take you (respectively) to -the previous unseen or next unseen article. (These are the ones that -are marked with "." in the summary mode lines.) - -+++ -*** The Gnus user variable 'nnimap-expunge' supports three new values: -'never' for never expunging messages, 'immediately' for immediately -expunging deleted messages, and 'on-exit' to expunge deleted articles -when exiting the group's summary buffer. Setting 'nnimap-expunge' to -nil or t is still supported but not recommended, since it may -result in Gnus expunging all messages that have been flagged as -deleted by any IMAP client (rather than just those that have been -deleted by Gnus). - -+++ -*** New user option 'gnus-use-atomic-windows' makes Gnus window layouts atomic. -See the "(elisp) Atomic Windows" node of the Elisp manual for details. - -+++ -*** There's a new value for 'gnus-article-date-headers', -'combined-local-lapsed', which will show both the time (in the local -timezone) and the lapsed time. - ---- -*** Gnus now maps imaps to 993 only on old MS-Windows versions. -The nnimap backend used to do this unconditionally to work around -problems on old versions of MS-Windows. This is now done only for -Windows XP and older. - -+++ -*** The nnimap backend now has support for IMAP namespaces. -This feature can be enabled by setting the new 'nnimap-use-namespaces' -server variable to non-nil. - -+++ -*** A prefix argument to 'gnus-summary-limit-to-score' will limit in reverse. -Limit to articles with score "at or below" the SCORE argument rather -than "at or above". - ---- -*** The function 'gnus-score-find-favorite-words' has been renamed -from 'gnus-score-find-favourite-words'. - ---- -*** Gmane has been removed as an nnir backend, since Gmane no longer -has a search engine. - -+++ -*** Splitting mail on common mailing list headers has been added. -See the concept index in the Gnus manual for the 'match-list' entry. - -+++ -*** nil is no longer an allowed value for 'mm-text-html-renderer'. - -+++ -*** The default value of 'mm-inline-large-images' has changed from nil -to 'resize', which means that large images will be resized instead of -displayed with an external program by default. - -+++ -*** A new Gnus summary mode command, 'S A' ('gnus-summary-attach-article') -can be used to attach the current article(s) to a pre-existing Message -buffer, or create a new Message buffer with the article(s) attached. - -+++ -*** A new Gnus summary mode command, 'w' ('gnus-summary-browse-url') -scans the article buffer for URLs, and offers them to the user to open -with 'browse-url'. - ---- -*** New user option 'nnir-notmuch-filter-group-names-function'. -This option controls whether and how to use Gnus search groups as -'path:' search terms to 'notmuch'. - ---- -*** The buttons in the Gnus article buffer were formerly widgets -(i.e., buttons from widget.el). This has now changed, and they are -now buttons (from button.el), and commands like 'TAB' now search for -buttons instead of widgets. There should be no user-visible changes, -but out-of-tree code that relied on widgets being present might now -fail. - -** erc - ---- -*** New hook 'erc-insert-done-hook'. -This hook is called after strings have been inserted into the buffer, -and is free to alter point and window configurations, as it's not -called from inside a 'save-excursion', as opposed to 'erc-insert-post-hook'. - ---- -*** 'erc-button-google-url' has been renamed to 'erc-button-search-url' -and its value has been changed to Duck Duck Go. - ---- -*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted. -The user option to use instead to alter text to be sent is now -'erc-pre-send-functions'. - ---- -*** Improve matching/highlighting of nicknames. -Open and close parenthesis and apostrophe are not considered valid -nick characters anymore, matching the given grammar in RFC 2812 -section 2.3.1. This enables correct matching and highlighting of -nicks when they are surrounded by parentheses, like "(nick)", and when -adjacent to an apostrophe, like "nick's". - ---- -*** Set 'erc-button-url-regexp' to 'browse-url-button-regexp' -which better handles surrounding pair of parentheses. - -** EUDC - ---- -*** XEmacs support has been removed. - -** eww/shr - -+++ -*** The new user option 'shr-cookie-policy' can be used to control -when to use cookies when fetching embedded images. The default is to -use them when the images are from the same domain as the main HTML -document. - -+++ -*** The 'eww' command can now create a new EWW buffer. -Invoking the command with a prefix argument will cause it to create a -new EWW buffer for the URL instead of reusing the default one. - -+++ -*** Clicking with the Ctrl key or 'C-u RET' on a link opens a new tab -when tab-bar-mode is enabled. - -+++ -*** The 'd' ('eww-download') command now falls back to current page's URL. -If this command is invoked with no URL at point, it now downloads the -current page instead of signaling an error. - -*** When opening external links in eww/shr (typically with the -'C-u RET' keystroke on a link), the link will be flashed with the new -'shr-selected-link' face to give the user feedback that the command -has been executed. - -+++ -*** New user option 'shr-discard-aria-hidden'. -If set, shr will not render tags with attribute 'aria-hidden="true"'. -This attribute is meant to tell screen readers to ignore a tag. - -+++ -*** 'shr-external-browser' has been made into an obsolete alias -of 'browse-url-secondary-browser-function'. - ---- -*** 'shr-tag-ol' now respects the ordered list 'start' attribute. - ---- -*** The following tags are now handled: '<code>', '<abbr>', and '<acronym>'. - -** Htmlfontify - -+++ -*** The functions 'hfy-color', 'hfy-color-vals' and -'hfy-fallback-color-values' and the variables 'hfy-fallback-color-map' -and 'hfy-rgb-txt-color-map' have been renamed from names that used -'colour' instead of 'color'. - -+++ -** Enriched mode supports the 'charset' text property. -You can add or modify the 'charset' text properties of text using the -'Edit->Text Properties->Special Properties' menu, or by invoking the -'facemenu-set-charset' command. Documents in Enriched mode will be -saved with the charset properties, and those properties will be -restored when the file is visited. - -** Smtpmail - ---- -*** Authentication mechanisms can be added via external packages, by -defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. - -+++ -*** To always force smtpmail to send credentials over on the first -attempt when communicating with the SMTP server(s), the -'smtpmail-servers-requiring-authorization' user option can be used. - -+++ -*** smtpmail will now try resending mail when getting a transient "4xx" -error message from the SMTP server. The new 'smtpmail-retries' -user option says how many times to retry. - -** Footnote mode - ---- -*** Support Hebrew-style footnotes. - ---- -*** Footnote text lines are now aligned. -Can be controlled via the new user option 'footnote-align-to-fn-text'. - -** CSS mode - ---- -*** A new command 'css-cycle-color-format' for cycling between color -formats (e.g. "black" => "#000000" => "rgb(0, 0, 0)") has been added, -bound to 'C-c C-f'. - ---- -*** CSS mode, SCSS mode, and Less CSS mode now have support for Imenu. - -** SGML mode - ---- -*** 'sgml-quote' now handles double quotes and apostrophes -when escaping text and in addition all numeric entities when -unescaping text. - -** Python mode - ---- -*** Python mode supports three different font lock decoration levels. -The maximum level is used by default; customize -'font-lock-maximum-decoration' to tone down the decoration. - ---- -*** New user option 'python-pdbtrack-kill-buffers'. -If non-nil, the default, buffers opened during pdbtracking session are -killed when pdbtracking session is finished. - ---- -*** New function 'python-shell-send-statement. -It sends the statement delimited by 'python-nav-beginning-of-statement' -and 'python-nav-end-of-statement' to the inferior Python process. +*** State changing VC operations are supported in dired-mode on files +(but still not on directories). ** Help ---- -*** Descriptions of variables and functions give an estimated first release -where the variable or function appeared in Emacs. - ---- -*** Output format of 'C-h l' ('view-lossage') has changed. -For convenience, 'view-lossage' now displays the last keystrokes -and commands in the same format as the edit buffer of -'edit-last-kbd-macro'. This makes it possible to copy the lines from -the buffer generated by 'view-lossage' to the "*Edit Macro*" buffer -created by 'edit-last-kbd-macro', and to save the macro by 'C-c C-c'. - ---- -*** The list of help commands produced by 'C-h C-h' ('help-for-help') -can now be searched via 'C-s'. - -** Ibuffer - ---- -*** New filter 'ibuffer-filter-by-process'; bound to '/ E'. - ---- -*** All mode filters can now accept a list of symbols. -This means you can now easily filter several major modes, as well -as a single mode. - -** Search and Replace - +++ -*** Isearch supports a prefix argument for 'C-s' ('isearch-repeat-forward') -and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these -commands repeat the search for the specified occurrence of the search string. -A negative argument repeats the search in the opposite direction. -This makes possible also to use a prefix argument for 'M-s .' -('isearch-forward-symbol-at-point') to find the next Nth symbol. -Also a prefix argument is supported for 'isearch-yank-until-char', -'isearch-yank-word-or-char', 'isearch-yank-symbol-or-char'. - -+++ -*** To go to the first/last occurrence of the current search string -is possible now with new commands 'isearch-beginning-of-buffer' and -'isearch-end-of-buffer' bound to 'M-s M-<' and 'M-s M->' in Isearch. -With a numeric argument, they go to the Nth absolute occurrence -counting from the beginning/end of the buffer. This complements -'C-s'/'C-r' that searches for the next Nth relative occurrence -with a numeric argument. - -+++ -*** 'isearch-lazy-count' shows the current match number and total number -of matches in the Isearch prompt. User options -'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the -format of the current and the total number of matches in the prompt's -prefix and suffix, respectively. +*** New command 'describe-keymap' describes keybindings in a keymap. --- -*** 'lazy-highlight-buffer' highlights matches in the full buffer. -It is useful in combination with 'lazy-highlight-cleanup' customized to nil -to leave matches highlighted in the whole buffer after exiting isearch. -Also when 'lazy-highlight-buffer' prepares highlighting in the buffer, -navigation through the matches without flickering is more smooth. -'lazy-highlight-buffer-max-at-a-time' controls the number of matches to -highlight in one iteration while processing the full buffer. - -+++ -*** New isearch bindings. -'C-M-z' invokes new function 'isearch-yank-until-char', which yanks -everything from point up to but not including the specified -character into the search string. This is especially useful for -keyboard macros. - -'C-M-w' in isearch changed from 'isearch-del-char' to the new function -'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to -'C-M-d'. - -+++ -'M-s h l' invokes 'highlight-lines-matching-regexp' using the search -string to highlight lines matching the search string. This is similar -to the existing binding 'M-s h r' ('highlight-regexp') that highlights -JUST the search string. - -+++ -*** New user option 'isearch-yank-on-move' provides options t and 'shift' -to extend the search string by yanking text that ends at the new -position after moving point in the current buffer. 'shift' extends -the search string by motion commands while holding down the shift key. - -+++ -*** 'isearch-allow-scroll' provides a new option 'unlimited' to allow -scrolling any distance off screen. - ---- -*** Isearch now remembers the regexp-based search mode for words/symbols -and case-sensitivity together with search strings in the search ring. +** The old non-SMIE indentation of 'sh-mode' has been removed. --- -*** Isearch now has its own tool-bar and menu-bar menu. - -+++ -*** 'flush-lines' prints and returns the number of deleted matching lines. +** The sb-image.el library is now marked obsolete. +This file was a compatibility kludge which is no longer needed. --- -*** 'char-fold-to-regexp' now matches more variants of a base character. -The table used to check for equivalence of characters is now built -using the complete chain of unicode decompositions of a character, -rather than stopping after one level, such that searching for -e.g. "GREEK SMALL LETTER IOTA" will now also find "GREEK SMALL LETTER -IOTA WITH OXIA". - -+++ -*** New char-folding options: 'char-fold-include' lets you add ad hoc -foldings, 'char-fold-exclude' to remove foldings from default decomposition, -and 'char-fold-symmetric' to search for any of an equivalence class of -characters. For example, with a nil value of 'char-fold-symmetric' -you can search for "e" to find "é", but not vice versa. With a non-nil -value you can search for either, for example, you can search for "é" -to find "e". - -** Debugger - -+++ -*** The Lisp Debugger is now based on 'backtrace-mode'. -Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "(elisp) Backtraces" in -the Elisp manual for documentation of the new mode and its commands. +** 'lisp-mode' now uses 'common-lisp-indent-function'. +To revert to the previous behaviour, +'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. ** Edebug +++ -*** 'edebug-eval-last-sexp' and 'edebug-eval-print-last-sexp' interactively -now take a zero prefix analogously to the non-Edebug counterparts. - -+++ -*** New faces 'edebug-enabled-breakpoint' and 'edebug-disabled-breakpoint'. -When setting breakpoints in Edebug, an overlay with these faces are -placed over the point in question, depending on whether they are -enabled or not. - -+++ -*** New command 'edebug-toggle-disable-breakpoint'. -This command allows you to disable a breakpoint temporarily. This is -mainly useful with breakpoints that are conditional and would take -some time to recreate. - -+++ -*** New command 'edebug-unset-breakpoints'. -To clear all breakpoints in the current form, the 'U' command in -'edebug-mode', or 'M-x edebug-unset-breakpoints' can be used. - ---- -*** Re-instrumenting a function with Edebug will now try to preserve -previously-set breakpoints. However, if the code has changed -substantially, this may not be possible. - -+++ -*** New command 'edebug-remove-instrumentation'. -This command removes Edebug instrumentation from all functions that -have been instrumented. - -+++ -*** The runtime behavior of Edebug's instrumentation can be changed -using the new variables 'edebug-behavior-alist', -'edebug-after-instrumentation-function' and -'edebug-new-definition-function'. Edebug's behavior can be changed -globally or for individual definitions. - -+++ -*** Edebug's backtrace buffer now uses 'backtrace-mode'. -Backtrace mode adds fontification, links and commands for changing the -appearance of backtrace frames. See the node "(elisp) Backtraces" in -the Elisp manual for documentation of the new mode and its commands. - -The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace' -which replaces 'edebug-backtrace'. Consequently Edebug's backtrace -windows now behave like those of the Lisp Debugger and of ERT, in that -when they appear they will be the selected window. - -The new 'backtrace-goto-source' command, bound to 's', works in -Edebug's backtraces on backtrace frames whose source code has -been instrumented by Edebug. - -** Enhanced xterm support - ---- -*** New user option 'xterm-set-window-title' controls whether Emacs sets -the XTerm window title. This feature is experimental and is disabled -by default. - -** Grep - -+++ -*** 'rgrep', 'lgrep' and 'zrgrep' now hide part of the command line -that contains a list of ignored directories and files. -Clicking on the button with ellipsis unhides it. -The abbreviation can be disabled by the new user option -'grep-find-abbreviate'. The new command -'grep-find-toggle-abbreviation' toggles it interactively. - ---- -*** 'grep-find-use-xargs' is now customizable with sorting options. - -** ERT - -+++ -*** New variable 'ert-quiet' allows making ERT output in batch mode -less verbose by removing non-essential information. - -+++ -*** ERT's backtrace buffer now uses 'backtrace-mode'. -Backtrace mode adds fontification and commands for changing the -appearance of backtrace frames. See the node "(elisp) Backtraces" in -the Elisp manual for documentation of the new mode and its commands. - -** Gamegrid - ---- -*** Gamegrid now determines its default glyph size based on display -dimensions, instead of always using 16 pixels. As a result, Tetris, -Snake and Pong are better playable on HiDPI displays. - ---- -*** 'gamegrid-add-score' can now sort scores from lower to higher. -This is useful for games where lower scores are better, like time-based games. - -** Filecache - ---- -*** Completing file names in the minibuffer via 'C-TAB' now uses the -styles as configured by the user option 'completion-styles'. - -** New macros 'thunk-let' and 'thunk-let*'. -These macros are analogue to 'let' and 'let*', but create bindings that -are evaluated lazily. - -** next-error - -+++ -*** New user option 'next-error-find-buffer-function'. -The value should be a function that determines how to find the -next buffer to be used by 'next-error' and 'previous-error'. The -default is to use the last buffer that navigated to the current -error. - -+++ -*** New command 'next-error-select-buffer'. -It can be used to set any buffer as the next one to be used by -'next-error' and 'previous-error'. - -** nxml-mode - ---- -*** The default value of 'nxml-sexp-element-flag' is now t. -This means that pressing 'C-M-SPACE' now selects the entire tree by -default, and not just the opening element. - -** Eshell - ---- -*** TAB completion uses the standard 'completion-at-point' rather than -'pcomplete'. Its UI is slightly different but can be customized to -behave similarly, e.g. Pcomplete's default cycling can be obtained -with '(setq completion-cycle-threshold 5)'. - ---- -*** Eshell no longer re-initializes its keymap every call. -This allows users to use (define-key eshell-mode-map ...) as usual. -Some modules have their own minor mode now to account for these -changes. - -+++ -*** Expansion of history event designators is disabled by default. -To restore the old behavior, use - - (add-hook 'eshell-expand-input-functions - #'eshell-expand-history-references) - ---- -*** The function 'eshell-uniquify-list' has been renamed from -'eshell-uniqify-list'. - ---- -*** The function 'eshell/kill' is now able to handle signal switches. -Previously 'eshell/kill' would fail if provided a kill signal to send -to the process. It now accepts signals specified either by name or by -its number. - ---- -*** Emacs now follows symlinks in history-related files. -The files specified by 'eshell-history-file-name' and -'eshell-last-dir-ring-file-name' can include symlinks; these are now -followed when Emacs writes the relevant history variables to the disk. - -** Shell - ---- -*** Program name completion inside remote shells works now as expected. - -+++ -*** The user option 'shell-file-name' can be set now as connection-local -variable for remote shells. It still defaults to "/bin/sh". - -** Single shell commands - -+++ -*** 'shell-command-dont-erase-buffer' accepts the value 'erase' to -force to erase the output buffer before execution of the command. - -*** The new functions 'shell-command-save-pos-or-erase' and -'shell-command-set-point-after-cmd' control how point is handled -between two consecutive shell commands in the same buffer. - -+++ -*** 'async-shell-command-width' defines the number of display columns -available for output of asynchronous shell commands. - -+++ -*** Prompt for shell commands can now show the current directory. -Customize the new user option 'shell-command-prompt-show-cwd' to enable it. - -** Pcomplete - ---- -*** The 'pcomplete' command is now obsolete. -The Pcomplete functionality can be obtained via 'completion-at-point' -instead, by adding 'pcomplete-completions-at-point' to -'completion-at-point-functions'. - ---- -*** The function 'pcomplete-uniquify-list' has been renamed from -'pcomplete-uniqify-list'. - ---- -*** 'pcomplete/make' now completes on targets in included files, recursively. -To recover the previous behavior, set new user option -'pcmpl-gnu-makefile-includes' to nil. - -** Auth-source - ---- -*** The Secret Service backend supports the ':create' key now. - ---- -*** ".authinfo" and ".netrc" files now use a new mode: 'authinfo-mode'. -This is just like 'fundamental-mode', except that it hides passwords -under a "****" display property. When the cursor moves to this text, -the real password is revealed (via 'reveal-mode'). The new -'authinfo-hidden' user option can be used to control what to hide. +*** Edebug specification lists can use the new keyword '&error', which +unconditionally aborts the current edebug instrumentation with the +supplied error message. ** Tramp +++ -*** New connection method "nextcloud", which allows accessing OwnCloud -or NextCloud hosted files and directories. - -+++ -*** New connection method "rclone", which allows accessing system -storages via the 'rclone' program. This feature is experimental. - -+++ -*** New connection method "sudoedit", which allows editing local files -with different user credentials. Contrary to the "sudo" method, no -session is run permanently in the background. This is for security -reasons. - -+++ -*** Connection methods "obex" and "synce" have been removed, because they -are obsoleted in GVFS. - -+++ -*** Validated passwords are saved by auth-source backends which support this. - -+++ -*** During user and host name completion in the minibuffer, results -from auth-source search are taken into account. This can be disabled -by setting the user option 'tramp-completion-use-auth-sources' to nil. - -+++ -*** The user option 'tramp-ignored-file-name-regexp' allows disabling -Tramp for some look-alike remote file names. - -+++ -*** For some connection methods, like "su" or "sudo", the host name in -multi-hop file names must match the previous hop. Default host names -are adjusted to the host name from the previous hop. - -+++ -*** A timeout has been added for the connection methods "sudo" and "doas". -The underlying session is disabled when the timeout expires. This is -for security reasons. - -+++ -*** For some connection methods, like "sshx" or "plink", it is -possible to configure the remote login shell. This avoids problems -with remote hosts, where "/bin/sh" is a link to a shell which -cooperates badly with Tramp. - -+++ -*** New commands 'tramp-rename-files' and 'tramp-rename-these-files'. -They allow saving remote files somewhere else when the corresponding -host is not reachable anymore. - -** Rcirc - ---- -*** New user option 'rcirc-url-max-length'. -Setting this option to an integer causes URLs displayed in Rcirc -buffers to be truncated to that many characters. - ---- -*** The default '/quit' and '/part' reasons are now configurable. -Two new user options are provided for this: -'rcirc-default-part-reason' and 'rcirc-default-quit-reason'. - -** Register - ---- -*** The return value of method 'register-val-describe' includes the -names of buffers shown by the windows of a window configuration. - -** Message - ---- -*** Completion of email addresses can use the standard completion UI. -This is controlled by 'message-expand-name-standard-ui'. -With the standard UI the different sources (ecomplete, bbdb, and eudc) -are matched together and try to obey 'completion-styles'. -It should work for other completion front ends like Company. - ---- -*** 'message-mode' now supports highlighting citations of different depths. -This can be customized via the new user option -'message-cite-level-function' and the new 'message-cited-text-*' faces. - -+++ -*** Messages can now be systematically encrypted -when the PGP keyring contains a public key for every recipient. To -achieve this, add 'message-sign-encrypt-if-all-keys-available' to -'message-send-hook'. - ---- -*** When replying a message that have addresses on the form -'"foo@bar.com" <foo@bar.com>', Message will elide the repeated "name" -from the address field in the response. - ---- -*** The default of 'message-forward-as-mime' has changed from t to nil -as it has been reported that many recipients can't read forwards that -are formatted as MIME digests. - -+++ -*** 'message-forward-included-headers' has changed its default to -exclude most headers when forwarding. - -*** 'mml-secure-openpgp-sign-with-sender' sets also "gpg --sender". -When 'mml-secure-openpgp-sign-with-sender' is non-nil message sender's -email address (in addition to its old behavior) will also be used to -set gpg's "--sender email@domain" option. - -The option is useful for two reasons when verifying the signature: - - 1. GnuPG's TOFU statistics are updated for the specific user id - (email) only. See gpg(1) man page about "--sender". - - 2. GnuPG's "--auto-key-retrieve" functionality can use WKD (web key - directory) method for finding the signer's key. You need GnuPG - 2.2.17 to fully benefit from this feature. See gpg(1) man page for - "--auto-key-retrieve". - ---- -** EasyPG - ---- -*** 'epa-pinentry-mode' is renamed to 'epg-pinentry-mode'. -It now applies to epg functions as well as epa functions. - ---- -*** The alias functions 'epa--encode-coding-string', -'epa--decode-coding-string', and 'epa--select-safe-coding-system' have -been removed. Use 'encode-coding-string', 'decode-coding-string', and -'select-safe-coding-system' instead. - ---- -*** 'epg-context' structure supports now 'sender' slot. -The value of the new 'sender' slot (if a string) is used to set gpg's -"--sender" option. This feature is used by -'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about -"--sender" for more information. - ---- -** Rmail - -+++ -*** New user option 'rmail-output-reset-deleted-flag'. -If this option is non-nil, messages appended to an output file by the -'rmail-output' command have their Deleted flag reset. - ---- -*** The command 'rmail-summary-by-senders' with an empty argument -selects the messages to summarize with a regexp that matches the -sender of the current message. - -** Threads - -+++ -*** New variable 'main-thread' holds Emacs's main thread. -This is handy in Lisp programs that run on a non-main thread and want -to signal the main thread, e.g., when they encounter an error. - -+++ -*** 'thread-join' now returns the result of the finished thread. - -+++ -*** 'thread-signal' does not propagate errors to the main thread. -Instead, error messages are just printed in the main thread. - ---- -*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. - -+++ -*** New command 'list-threads' shows Lisp threads. -See the current list of live threads in a tabulated-list buffer which -automatically updates. In the buffer, you can use 's q' or 's e' to -signal a thread with quit or error respectively, or get a snapshot -backtrace with 'b'. - -** thingatpt.el - ---- -*** 'thing-at-point' supports a new "thing" called 'uuid'. -A symbol 'uuid' can be passed to 'thing-at-point' and it returns the -UUID at point. - ---- -*** 'number-at-point' will now recognize hex numbers like 0xAb09 and #xAb09 -and return them as numbers. - ---- -*** 'word-at-point' and 'sentence-at-point' accept NO-PROPERTIES. -Just like 'thing-at-point' itself. - -** Interactive automatic highlighting - -+++ -*** 'highlight-regexp' can now highlight subexpressions. -The new command accepts a prefix numeric argument to choose the -subexpression. - -** Mouse display of minor mode menu - ---- -*** 'minor-mode-menu-from-indicator' now displays full minor mode name. -When there is no menu for a mode, display the mode name after the -indicator instead of just the indicator (which is sometimes cryptic). - -** rx - ---- -*** rx now handles raw bytes in character alternatives correctly, -when given in a string. Previously, '(any "\x80-\xff")' would match -characters U+0080...U+00FF. Now the expression matches raw bytes in -the 128...255 range, as expected. - ---- -*** The rx 'or' and 'seq' forms no longer require any arguments. -'(or)' produces a regexp that never matches anything, while '(seq)' -matches the empty string, each being an identity for the operation. -This also works for their aliases: '|' for 'or'; ':', 'and' and -'sequence' for 'seq'. -The symbol 'unmatchable' can be used as an alternative to '(or)'. - ---- -*** 'regexp' and new 'literal' accept arbitrary lisp as arguments. -In this case, 'rx' will generate code which produces a regexp string -at run time, instead of a constant string. - ---- -*** New rx extension mechanism: 'rx-define', 'rx-let', 'rx-let-eval'. -These macros add new forms to the rx notation. - -+++ -*** 'anychar' is now an alias for 'anything'. -Both match any single character; 'anychar' is more descriptive. - -+++ -*** New 'intersection' form for character sets. -With 'or' and 'not', it can be used to compose character-matching -expressions from simpler parts. - -+++ -*** 'not' argument can now be a character or single-char string. - -** Frames - -+++ -*** New command 'make-frame-on-monitor' makes a frame on the specified monitor. - -+++ -*** New value of 'minibuffer' frame parameter 'child-frame'. -This allows creating and immediately parenting a minibuffer-only child -frame when making a frame. - ---- -*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'. -These predicates are to be preferred over 'display-graphic-p' when -testing for blinking cursor capability and the capability to have -symbols (e.g., '[return]', '[tab]', '[backspace]') as keys respectively. - -** Tabulated List mode - -+++ -*** New user options for tabulated list sort indicators. -You can now customize which sorting indicator character to display -near the current column in Tabulated Lists (see user options -'tabulated-list-gui-sort-indicator-asc', -'tabulated-list-gui-sort-indicator-desc', -'tabulated-list-tty-sort-indicator-asc', and -'tabulated-list-tty-sort-indicator-desc'). - -+++ -*** Two new commands and keystrokes have been added to the tabulated -list mode: 'w' (which widens the current column) and 'c' which makes -the current column contract. - -+++ -*** New function 'tabulated-list-clear-all-tags'. -This function clears all tags from the padding area in the current -buffer. Tags are typically added by calling 'tabulated-list-put-tag'. - -** Text mode - -+++ -*** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead. - -** CUA mode - ---- -*** New user option 'cua-rectangle-terminal-modifier-key'. -This user option allows for the customization of the modifier key used -in a terminal frame. - -** JS mode - ---- -*** JSX syntax is now automatically detected and enabled. -If a file imports Facebook's 'React' library, or if the file uses the -extension ".jsx", then various features supporting XML-like syntax -will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' -no longer needs to be enabled.) - ---- -*** New user option 'js-jsx-detect-syntax' disables automatic detection. -This is turned on by default. - ---- -*** New user option 'js-jsx-syntax' enables JSX syntax unconditionally. -This is off by default. - ---- -*** New variable 'js-jsx-regexps' controls JSX detection. - ---- -*** JSX syntax is now highlighted like SGML. - ---- -*** JSX code is properly indented in many more scenarios. -Previously, JSX indentation usually only worked when an element was -wrapped in parenthesis (e.g. in a 'return' statement or a function -call). It would also fail in many intricate cases. Now, indentation -should work anywhere without parenthesis; many more intricacies are -supported; and, indentation conventions align more closely with those -of the React developer community (see 'js-jsx-align->-with-<'), -otherwise still adhering to SGML conventions. - ---- -*** New user option 'js-jsx-align->-with-<' controls '>' indents. -Commonly in JSX code, a '>' on its own line is indented at the same -level as its opening '<'. This is the new default for JSX. This -behavior is slightly different than that used by SGML in Emacs, where -'>' is indented at the same level as attributes, which was also the -old default for JSX. - -This is turned on by default. To get back the old default indentation -behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<' -to nil. - ---- -*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. -Since JSX is a syntax extension of JavaScript, it makes the most sense -for JSX expressions to be indented the same number of spaces as other -JS expressions. This is a breaking change, but it probably aligns -with how you'd expect this indentation to behave. If you want JSX to -be indented like JS, you won't need to change your config. - -The old behavior can be emulated by controlling JSX indentation -independently of JS, by setting 'js-jsx-indent-level'. - ---- -*** New user option 'js-jsx-indent-level' for different JSX indentation. -If you wish to indent JSX by a different number of spaces than JS, set -this user option to the desired number. - ---- -*** New user option 'js-jsx-attribute-offset' for JSX attribute indents. - ---- -*** New variable 'js-syntactic-mode-name' controls mode name display. -Previously, the mode name was simply 'JavaScript'. Now, when a syntax -extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. -Set this variable to nil to disable the new behavior. - ---- -*** New function 'js-use-syntactic-mode-name' for deriving modes. -Packages deriving from 'js-mode' with 'define-derived-mode' should -call this function to add enabled syntax extensions to their mode -name, too. - -** Autorevert - -+++ -*** New user option 'auto-revert-avoid-polling' for saving power. -When set to a non-nil value, buffers in Auto Revert mode are no longer -polled for changes periodically. This reduces the power consumption -of an idle Emacs, but may fail on some network file systems; set -'auto-revert-notify-exclude-dir-regexp' to match files where -notification is not supported. The default value is nil. - -+++ -*** New variable 'buffer-auto-revert-by-notification'. -A major mode can declare that notification on the buffer's default -directory is sufficient to know when updates are required, by setting -the new variable 'buffer-auto-revert-by-notification' to a non-nil -value. Auto Revert mode can use this information to avoid polling the -buffer periodically when 'auto-revert-avoid-polling' is non-nil. - ---- -*** 'global-auto-revert-ignore-buffer' can now also be a predicate -function that can be used for more fine-grained control of which -buffers to auto-revert. - -** auth-source-pass - -+++ -*** New user option 'auth-source-pass-filename'. -Allows setting the path to the password-store, defaults to -"~/.password-store". - -+++ -*** New user option 'auth-source-pass-port-separator'. -Specifies separator between host and port, defaults to colon ":". - ---- -*** Minimize the number of decryptions during password lookup. -This makes the package usable with physical tokens requiring touching -a sensor for every decryption. - ---- -*** 'auth-source-pass-get' is now autoloaded. - -** Bookmarks - ---- -*** 'bookmark-file' and 'bookmark-old-default-file' are now obsolete -aliases of 'bookmark-default-file'. - ---- -*** New user option 'bookmark-watch-bookmark-file'. -When non-nil, watch whether the bookmark file has changed on disk. - ---- -*** The old bookmark file format is no longer supported. -This bookmark file format has not been used in Emacs since at least -version 19.34, released in 1996, and will no longer be automatically -converted to the new bookmark file format. - -The following functions are now declared obsolete: -'bookmark-grok-file-format-version', -'bookmark-maybe-upgrade-file-format', -'bookmark-upgrade-file-format-from-0', and -'bookmark-upgrade-version-0-alist'. - ---- -** The mantemp.el library is now marked obsolete. -This library generates manual C++ template instantiations. It should -no longer be useful on modern compilers, which do this automatically. - -** Ispell - ---- -*** New hook 'ispell-change-dictionary-hook'. -This runs after changing the dictionary and could be used to -automatically spellcheck a buffer when changing language without -needing to advice 'ispell-change-dictionary'. - -** scroll-lock - ---- -*** New command 'scroll-lock-next-line-always-scroll'. -This command is bound to 'S-down' and scrolls the buffer up in -particular when the end of the buffer is visible in the window. - -** mwheel.el - ---- -*** 'mwheel-install' is now obsolete. -Use 'mouse-wheel-mode' instead. Note that 'mouse-wheel-mode' is -already enabled by default on most graphical displays. - -** Gravatar - -+++ -*** 'gravatar-cache-ttl' is now a number of seconds. -The previously used timestamp format of a list of integers is still -supported, but is deprecated. The default value has not changed. - -+++ -*** 'gravatar-size' can now be nil. -This results in the use of Gravatar's default size of 80 pixels. - -+++ -*** The default fallback gravatar is now configurable. -This is possible using the new user options 'gravatar-default-image' -and 'gravatar-force-default'. - -** ada-mode - ---- -*** The built-in ada-mode is now deleted. The GNU ELPA package is a -good replacement, even in very large source files. - -** time-stamp - ---- -*** New '%5z' conversion for 'time-stamp-format' gives time zone offset. -Specifying '%5z' in 'time-stamp-format' or 'time-stamp-pattern' -expands to the time zone offset, e.g., '+0100'. The time zone used is -specified by 'time-stamp-time-zone'. - -Because this feature is new in Emacs 27.1, do not use it in the local -variables section of any file that might be edited by an older version -of Emacs. - ---- -*** Some conversions recommended for 'time-stamp-format' have changed. -The new documented/recommended %-conversions are closer to those -used by 'format-time-string' and are compatible at least as far back -as Emacs 22.1 (released in 2007). - -Uppercase abbreviated day name of week: was %3A, now %#a -Full day name of week: was %:a, now %:A -Uppercase abbreviated month name: was %3B, now %#b -Full month name: was %:b, now %:B -Four-digit year: was %:y, now %Y -Lowercase timezone name: was %z, now %#Z -Fully-qualified host name: was %s, now %Q -Unqualified host name: (was none), now %q -Login name: was %u, now %l -User's full name: was %U, now %L - -Merely having '(add-hook 'before-save-hook 'time-stamp)' in your -Emacs init file does not expose you to this change. However, -if you set 'time-stamp-format' or 'time-stamp-pattern' with a -file-local variable, you may need to update the value. +*** New connection method "media", which allows accessing media devices +like cell phones, tablets or cameras. -** mode-local - ---- -*** Declare 'define-overload' and 'define-child-mode' as obsolete. - ---- -*** Rename several internal functions to use a 'mode-local-' prefix. - -** CC Mode - -+++ -*** You can now flag "wrong style" comments with 'font-lock-warning-face'. -To do this, use 'c-toggle-comment-style', if needed, to set the desired -default comment style (block or line); then set the user option -'c-mark-wrong-style-of-comment' to non-nil. - -** Mailcap - ---- -*** The new function 'mailcap-file-name-to-mime-type' has been added. -It's a simple convenience function for looking up MIME types based on -file name extensions. +** map.el ---- -*** The default way the list of possible external viewers for MIME -types is sorted and chosen has changed. Earlier, the most specific -viewer was chosen, even if there was a general override in "~/.mailcap". -For instance, if "/etc/mailcap" has an entry for "image/gif", that one -will be chosen even if you have an entry for "image/*" in your -"~/.mailcap" file. But with the new method, entries from "~/.mailcap" -overrides all system and Emacs-provided defaults. To get the old -method back, set 'mailcap-prefer-mailcap-viewers' to nil. +*** Pcase 'map' pattern added keyword symbols abbreviation. +A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', +equivalent to '(map (:sym sym))'. +** Package -** MH-E +++ -*** The hook 'mh-show-mode-hook' is now called before the message is inserted. -Functions that want to affect the message text (for example, to change -highlighting) can no longer use 'mh-show-mode-hook', because the -message contents will not yet have been inserted when the hook is -called. Such functions should now be attached to 'mh-show-hook'. +*** New functions to filter the package list. +The filter command key bindings are as follows: -** URL - ---- -*** The 'file:' handler no longer looks for "index.html" in -directories if you ask it for a "file:///dir" URL. Since this is a -low-level library, such decisions (if they are to be made at all) are -left to higher-level functions. +key binding +--- ------- +/ a package-menu-filter-by-archive +/ k package-menu-filter-by-keyword +/ n package-menu-filter-by-name +/ s package-menu-filter-by-status +/ v package-menu-filter-by-version +/ / package-menu-filter-clear -* New Modes and Packages in Emacs 27.1 - -** Tab Bars - -+++ -*** Tab Bar mode -The new command 'tab-bar-mode' enables the tab bar at the top of each -frame, where you can use tabs to switch between named persistent -window configurations. - -The 'C-x t' sequence is the new prefix key for tab-related commands: -'C-x t 2' creates a new tab; 'C-x t 0' deletes the current tab; -'C-x t b' switches to buffer in another tab; 'C-x t f' and 'C-x t C-f' -edit file in another tab; and 'C-TAB' and 'S-C-TAB' switch to the next -or previous tab. You can also switch between tabs and create/delete -tabs with a mouse. - -Tab-related commands are available even when 'tab-bar-mode' is -disabled: by default, they enable 'tab-bar-mode' in that case. - -The X resource "tabBar", class "TabBar" enables the tab bar -when its value is "on", "yes" or "1". - -The user option 'tab-bar-position' specifies where to show the tab bar. - -Read the new Info node "(emacs) Tab Bars" for full description -of all related features. - -+++ -*** Tab Line mode -The new command 'global-tab-line-mode' enables the tab line above each -window, which you can use to switch buffers in the window. Selecting -the previous window-local tab is the same as typing 'C-x <LEFT>' -('previous-buffer'), selecting the next tab is the same as 'C-x <RIGHT>' -('next-buffer'). Both commands support a numeric prefix argument as -a repeat count. Clicking on the plus icon adds a new buffer to the -window-local tab line of buffers. Using the mouse wheel on the tab -line scrolls tabs. - -+++ -** fileloop.el lets one setup multifile operations like search&replace. - -+++ -** Emacs can now visit files in archives as if they were directories. -This feature uses Tramp and works only on systems which support GVFS, -i.e. GNU/Linux, roughly spoken. See the node "(tramp) Archive file -names" in the Tramp manual for full documentation of these facilities. - -+++ -** New library for writing JSONRPC applications (https://jsonrpc.org). -The 'jsonrpc' library enables writing Emacs Lisp applications that -rely on this protocol. Since the protocol is designed to be -transport-agnostic, the library provides an API to implement new -transport strategies as well as a separate API to use them. A -transport implementation for process-based communication, such as is -used by the Language Server Protocol (LSP), is readily available. - -+++ -** Backtrace mode improves viewing of Elisp backtraces. -Backtrace mode adds pretty printing, fontification and ellipsis -expansion to backtrace buffers produced by the Lisp debugger, Edebug -and ERT. See the node "(elisp) Backtraces" in the Elisp manual for -documentation of the new mode and its commands. - -+++ -** so-long.el helps to mitigate performance problems with long lines. -When 'global-so-long-mode' has been enabled, visiting a file with very -long lines will (subject to configuration) cause the user's preferred -'so-long-action' to be automatically invoked (by default, the buffer's -major mode is replaced by 'so-long-mode'). In extreme cases this can -prevent delays of several minutes, and make Emacs responsive almost -immediately. Type 'M-x so-long-commentary' for full documentation. +* New Modes and Packages in Emacs 28.1 -* Incompatible Lisp Changes in Emacs 27.1 - ---- -** Incomplete destructive splicing support has been removed. -Support for Common Lisp style destructive splicing (",.") was -incomplete and broken for a long time. It has now been removed. - -This means that backquote substitution now works for identifiers -starting with a period ("."). Consider the following example: - - (let ((.foo 42)) `,.foo) - -In the past, this would have incorrectly evaluated to '(\,\. foo)', -but will now instead evaluate to '42'. - ---- -** The REGEXP in 'magic-mode-alist' is now matched case-sensitively. -Likewise for 'magic-fallback-mode-alist'. - -+++ -** 'add-hook' does not always add to the front or the end any more. -The replacement of 'append' with 'depth' implies that the function is -not always added to the very front (when append/depth is nil) or the -very end (when append/depth is t) any more because other functions on -the hook may have specified higher/lower depths. This makes it -possible to control the ordering of functions more precisely, as was -already possible in 'add-function' and 'advice-add'. - ---- -** In 'compilation-error-regexp-alist' the old undocumented feature -where 'line' could be a function of 2 arguments has been dropped. - ---- -** 'define-fringe-bitmap' is always defined, even when Emacs is built -without any GUI support. - ---- -** Just loading a theme's file no longer activates the theme's settings. -Loading a theme with 'M-x load-theme' still activates the theme, as it -did before. However, loading the theme's file with 'M-x load-file', -or using 'require' or 'load' in a Lisp program, doesn't actually apply -the theme's settings until you either invoke 'M-x enable-theme' or -type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or -invoking 'load-theme' with NO-ENABLE argument omitted or nil has the -same effect of activating a theme whose file has been loaded.) The -special case of the 'user' theme is an exception: it is frequently -used for ad-hoc customizations, so the settings of that theme are by -default applied immediately. - -The variable 'custom--inhibit-theme-enable' controls this behavior; -its default value changed in Emacs 27.1. - ---- -** The REPETITIONS argument of 'benchmark-run' can now also be a variable. - ---- -** Interpretation of relative 'HOME' directory has changed. -If "$HOME" is set to a relative file name, 'expand-file-name' now -interprets it relative to the directory where Emacs was started, not -relative to the 'default-directory' of the current buffer. We recommend -always setting "$HOME" to an absolute file name, so that its meaning is -independent of where Emacs was started. - ---- -** 'file-name-absolute-p' no longer considers "~foo" to be an absolute -file name if there is no user named "foo". - -+++ -** The FILENAME argument to 'file-name-base' is now mandatory and no -longer defaults to 'buffer-file-name'. - -+++ -** File metadata primitives now signal an error if I/O, access, or -other serious errors prevent them from determining the result. -Formerly, these functions often (though not always) silently returned -nil. For example, if there is an access error, I/O error or low-level -integer overflow when getting the attributes of a file F, -'(file-attributes F)' now signals an error instead of returning nil. -These functions still behave as before if the only problem is that the -file does not exist. The affected primitives are -'directory-files-and-attributes', 'file-acl', 'file-attributes', -'file-modes', 'file-newer-than-file-p', 'file-selinux-context', -'file-system-info', and 'set-visited-file-modtime'. - ---- -** The function 'eldoc-message' now accepts a single argument. -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. - ---- -** Old-style backquotes now generate an error. -They have been generating warnings for a decade. To interpret -old-style backquotes as new-style, bind the new variable -'force-new-style-backquotes' to t. - ---- -** Defining a Common Lisp structure using 'cl-defstruct' or -'cl-struct-define' whose name clashes with a builtin type (e.g., -'integer' or 'hash-table') now signals an error. - ---- -** When formatting a floating-point number as an octal or hexadecimal -integer, Emacs now signals an error if the number is too large for the -implementation to format. - -+++ -** 'logb' now returns infinity when given an infinite or zero argument, -and returns a NaN when given a NaN. Formerly, it returned an extreme -fixnum for such arguments. - ---- -** Some functions and variables obsolete since Emacs 22 have been removed: -'archive-mouse-extract', 'assoc-ignore-case', 'assoc-ignore-representation', -'backward-text-line', 'blink-cursor', 'bookmark-exit-hooks', -'c-opt-op-identitier-prefix', 'comint-use-prompt-regexp-instead-of-fields', -'compilation-finish-function', 'count-text-lines', 'cperl-vc-header-alist', -'custom-face-save-command', 'cvs-display-full-path', 'cvs-fileinfo->full-path', -'delete-frame-hook', 'derived-mode-class', 'describe-char-after', -'describe-project', 'desktop-basefilename', 'desktop-buffer-handlers', -'desktop-buffer-misc-functions', 'desktop-buffer-modes-to-save', -'desktop-enable', 'desktop-load-default', 'dired-omit-files-p', -'disabled-command-hook', 'dungeon-mode-map', 'electric-nroff-mode', -'electric-nroff-newline', 'electric-perl-terminator', 'focus-frame', -'forward-text-line', 'generic-define-mswindows-modes', -'generic-define-unix-modes', 'generic-font-lock-defaults', -'goto-address-at-mouse', 'highlight-changes-colours', -'ibuffer-elide-long-columns', 'ibuffer-hooks', 'ibuffer-mode-hooks', -'icalendar-convert-diary-to-ical', 'icalendar-extract-ical-from-buffer', -'imenu-always-use-completion-buffer-p', 'ipconfig-program', -'ipconfig-program-options', 'isearch-lazy-highlight-cleanup', -'isearch-lazy-highlight-initial-delay', 'isearch-lazy-highlight-interval', -'isearch-lazy-highlight-max-at-a-time', 'iswitchb-use-fonts', -'latin1-char-displayable-p', 'mouse-wheel-click-button', -'mouse-wheel-down-button', 'mouse-wheel-up-button', 'new-frame', -'pascal-outline', 'process-kill-without-query', -'recentf-menu-append-commands-p', 'rmail-pop-password', -'rmail-pop-password-required', 'savehist-load', 'set-default-font', -'spam-list-of-processors', 'speedbar-add-ignored-path-regexp', -'speedbar-buffers-line-path', 'speedbar-ignored-path-expressions', -'speedbar-ignored-path-regexp', 'speedbar-line-path', 'speedbar-path-line', -'timer-set-time-with-usecs', 'tooltip-gud-display', 'tooltip-gud-modes', -'tooltip-gud-toggle-dereference', 'unfocus-frame', 'unload-hook-features-list', -'update-autoloads-from-directories', 'vc-comment-ring', 'vc-comment-ring-index', -'vc-comment-search-forward', 'vc-comment-search-reverse', -'vc-comment-to-change-log', 'vc-diff-switches-list', 'vc-next-comment', -'vc-previous-comment', 'view-todo', 'x-lost-selection-hooks', -'x-sent-selection-hooks'. - ---- -** Further functions and variables obsolete since Emacs 24 have been removed: -'default-directory-alist', 'dired-default-directory', -'dired-default-directory-alist', 'dired-enable-local-variables', -'dired-hack-local-variables', 'dired-local-variables-file', -'dired-omit-here-always'. - -+++ -** Garbage collection no longer treats miscellaneous objects specially; -they are now allocated like any other pseudovector. As a result, the -'garbage-collect' and 'memory-use-count' functions no longer return a -'misc' component, and the 'misc-objects-consed' variable has been -removed. - -+++ -** Reversed character ranges are no longer permitted in 'rx'. -Previously, ranges where the starting character is greater than the -ending character were silently omitted. -For example, '(rx (any "@z-a" (?9 . ?0)))' would match '@' only. -Now, such 'rx' expressions generate an error. - ---- -** Internal 'rx' functions and variables have been removed, -as a consequence of an improved implementation. Packages using -these should use the public 'rx' and 'rx-to-string' instead. -'rx-constituents' is still available for compatibility, but the new -extension mechanism is preferred: 'rx-define', 'rx-let' and -'rx-let-eval'. - -+++ -** 'text-mode' no longer sets the value of 'indent-line-function'. -The global value of 'indent-line-function', which defaults to -'indent-relative', will no longer be reset locally when turning on -'text-mode'. - -To get back the old behavior, add a function to 'text-mode-hook' which -performs '(setq-local indent-line-function #'indent-relative)'. - ---- -** 'make-process' no longer accepts a non-nil ':stop' key. This has -never worked reliably, and now causes an error. - -+++ -** 'eventp' no longer returns non-nil for lists whose car is nil. -This is consistent with the fact that nil, though a symbol, is not a -valid event type. - ---- -** The obsolete package xesam.el (since Emacs 24) has been removed. - -+++ -** The XBM image handler now accepts a ':stride' argument, which should -be specified in image specs representing the entire bitmap as a single -bool vector. - -+++ -** 'regexp-quote' may return its argument string. -If the argument needs no quoting, it can be returned instead of a copy. - -+++ -** Mouse scroll up and down with control key modifier changes font size. -Previously, the control key modifier was used to scroll up or down by -an amount which was close to near a full screen. This is now instead -available by scrolling with the meta modifier key. - -To get the old behavior back, customize the user option -'mouse-wheel-scroll-amount', or add the following to your init file: +* Incompatible Lisp Changes in Emacs 28.1 -(customize-set-variable 'mouse-wheel-scroll-amount - '(5 ((shift) . 1) ((control) . nil))) - -By default, the font size will be changed in the window that the mouse -pointer is over. To change this behavior, you can customize the user -option 'mouse-wheel-follow-mouse'. Note that this will also affect -scrolling. - -+++ -** Mouse scroll up and down with control key modifier also works on images -where it scales the image under the mouse pointer. - ---- -** 'help-follow-symbol' now signals 'user-error' if point (or the -position pointed to by the argument POS) is not in a symbol. +** 'equal' no longer examines some contents of window configurations. +Instead, it considers window configurations to be equal only if they +are 'eq'. To compare contents, use 'compare-window-configurations' +instead. This change helps fix a bug in 'sxhash-equal', which returned +incorrect hashes for window configurations and some other objects. --- -** The options.el library has been removed. -It was obsolete since Emacs 22.1, replaced by customize. +** The obsolete function 'thread-alive-p' has been removed. ---- -** The tls.el and starttls.el libraries are now marked obsolete. -Use of built-in libgnutls based functionality (described in the Emacs -GnuTLS manual) is recommended instead. +** 'dns-query' now consistently uses Lisp integers to represent integers. +Formerly it made an exception for integer components of SOA records, +because SOA serial numbers can exceed fixnum ranges on 32-bit platforms. +Emacs now supports bignums so this old glitch is no longer needed. ---- -** The url-ns.el library is now marked obsolete. -This library is used to open configuration files for the long defunct -web browser Netscape, and is no longer relevant. +** The Lisp variables 'previous-system-messages-locale' and +'previous-system-time-locale' have been removed, as they were created +by mistake and were not useful to Lisp code. -* Lisp Changes in Emacs 27.1 - -+++ -** Emacs Lisp integers can now be of arbitrary size. -Emacs uses the GNU Multiple Precision (GMP) library to support -integers whose size is too large to support natively. The integers -supported natively are known as "fixnums", while the larger ones are -"bignums". The new predicates 'bignump' and 'fixnump' can be used to -distinguish between these two types of integers. - -All the arithmetic, comparison, and logical (a.k.a. "bitwise") -operations where bignums make sense now support both fixnums and -bignums. However, note that unlike fixnums, bignums will not compare -equal with 'eq', you must use 'eql' instead. (Numerical comparison -with '=' works on both, of course.) - -Since large bignums consume a lot of memory, Emacs limits the size of -the largest bignum a Lisp program is allowed to create. The -nonnegative value of the new variable 'integer-width' specifies the -maximum number of bits allowed in a bignum. Emacs signals an integer -overflow error if this limit is exceeded. - -Several primitive functions formerly returned floats or lists of -integers to represent integers that did not fit into fixnums. These -functions now simply return integers instead. Affected functions -include functions like 'encode-char' that compute code-points, functions -like 'file-attributes' that compute file sizes and other attributes, -functions like 'process-id' that compute process IDs, and functions like -'user-uid' and 'group-gid' that compute user and group IDs. - -+++ -** 'overflow-error' is now documented as a subcategory of 'range-error'. -Formerly it was undocumented, and was (incorrectly) a subcategory -of 'domain-error'. - -** Time values - -+++ -*** New function 'time-convert' converts Lisp time values to Lisp -timestamps of various forms, including a new timestamp form '(TICKS -. HZ)' where TICKS is an integer and HZ a positive integer denoting a -clock frequency. - -+++ -*** Although the default timestamp format is still '(HI LO US PS)', -it is planned to change in a future Emacs version, to exploit bignums. -The documentation has been updated to mention that the timestamp -format may change and that programs should use functions like -'format-time-string', 'decode-time', and 'time-convert' rather than -probing the innards of a timestamp directly, or creating a timestamp -by hand. - -+++ -*** Decoded (calendrical) timestamps now have subsecond resolution. -This affects 'decode-time', which generates these timestamps, as well -as functions like 'encode-time' that accept them. The subsecond info -is present as a '(TICKS . HZ)' value in the seconds element of a -decoded timestamp, and 'decode-time' has a new optional FORM argument -specifying the form of the seconds member. For example, if X is the -timestamp '(1566009571321878186 . 1000000000)', which represents -"2019-08-17 02:39:31.321878186 UTC", '(decode-time X t t)' returns -'((31321878186 . 1000000000) 39 2 17 8 2019 6 nil 0)' instead of the -traditional '(31 39 2 17 8 2019 6 nil 0)' returned by plain -'(decode-time X t)'. Although the default FORM is currently -'integer', which truncates the seconds to an integer and is the -traditional behavior, this default may change in future Emacs -versions, so callers requiring an integer should specify FORM -explicitly. - -+++ -*** 'encode-time' supports a new API '(encode-time TIME)'. -The old 'encode-time' API is still supported. - -+++ -*** A new package to parse ISO 8601 time, date, durations and -intervals has been added. The main function to use is -'iso8601-parse', but there's also 'iso8601-parse-date', -'iso8601-parse-time', 'iso8601-parse-duration' and -'iso8601-parse-interval'. All these functions return decoded time -structures, except the final one, which returns three of them (start, -end and duration). - -+++ -*** 'time-add', 'time-subtract', and 'time-less-p' now accept -infinities and NaNs too, and propagate them or return nil like -floating-point operators do. If both arguments are finite, these -functions now return exact results instead of rounding in some cases, -and they also avoid excess precision when that is easy. - -+++ -*** New function 'time-equal-p' compares time values for equality. - -+++ -*** 'format-time-string' supports a new conversion specifier flag '+' -that acts like the '0' flag but also puts a '+' before nonnegative -years containing more than four digits. This is for compatibility -with POSIX.1-2017. - -+++ -*** To access (or alter) the elements of a decoded time value, the -'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour', -'decoded-time-day', 'decoded-time-month', 'decoded-time-year', -'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone' -accessors can be used. - -*** The new functions 'date-days-in-month' (which will say how many -days there are in a month in a specific year), 'date-ordinal-to-time' -(that computes the date of an ordinal day), 'decoded-time-add' (for -doing computations on a decoded time structure), 'make-decoded-time' -(for making a decoded time structure with only the given keywords -filled out), and 'encoded-time-set-defaults' (which fills in nil -elements as if it's midnight January 1st, 1970) have been added. - -+++ -*** In the DST slot, 'encode-time' and 'parse-time-string' now return -1 -if it is not known whether daylight saving time is in effect. -Formerly they were inconsistent: 'encode-time' returned t in this -situation, whereas 'parse-time-string' returned nil. Now they -consistently use nil to mean that DST is not in effect, and use -1 -to mean that it is not known whether DST is in effect. - -+++ -** New macro 'benchmark-progn'. -This macro works like 'progn', but messages how long it takes to -evaluate the body forms. The value of the last form is the return -value. - -+++ -** New function 'read-char-from-minibuffer'. -This function works like 'read-char', but uses 'read-from-minibuffer' -to read a character, so it maintains a history that can be navigated -via usual minibuffer keystrokes 'M-p'/'M-n'. - ---- -** New variables 'set-message-function' and 'clear-message-function' -can be used to specify functions to show and clear messages that -normally are displayed in the echo area. - -+++ -** 'setq-local' can now set an arbitrary number of variables, which -makes the syntax more like 'setq'. - ---- -** 'reveal-mode' can now also be used for more than to toggle between -invisible and visible: It can also toggle 'display' properties in -overlays. This is only done on 'display' properties that have the -'reveal-toggle-invisible' property set. - -+++ -** 'process-contact' now takes an optional NO-BLOCK argument to allow -not waiting for a process to be set up. - ---- -** New variable 'read-process-output-max' controls sub-process throughput. -This variable determines how many bytes can be read from a sub-process -in one read operation. The default, 4096 bytes, was previously a -hard-coded constant. Setting it to a larger value might enhance -throughput of reading from sub-processes that produces vast -(megabytes) amounts of data in one go. - -+++ -** The new user option 'quit-window-hook' is now run first when -executing the 'quit-window' command. - -** The user options 'help-enable-completion-auto-load', -'help-enable-auto-load' and 'vhdl-project-auto-load', as well as the -function 'vhdl-auto-load-project' have been renamed to have "autoload" -without the hyphen in their names. Obsolete aliases from the old -names have been added. - -+++ -** Buttons (created with 'make-button' and related functions) can -now use the 'button-data' property. If present, the data in this -property will be passed on to the 'action' function instead of the -button itself in 'button-activate'. +* Lisp Changes in Emacs 28.1 -+++ -** 'defcustom' now takes a ':local' keyword that can be either t or -'permanent', which mean that the variable should be automatically -buffer-local. 'permanent' also sets the variable's 'permanent-local' -property. +** The variable 'force-new-style-backquotes' has been removed. +This removes the final remaining trace of old-style backquotes. -+++ -** The new macro 'with-suppressed-warnings' can be used to suppress -specific byte-compile warnings. +** The module header 'emacs-module.h' now contains type aliases +'emacs_function' and 'emacs_finalizer' for module functions and +finalizers, respectively. -+++ -** The new macro 'ignore-error' is like 'ignore-errors', but takes a -specific error condition, and will only ignore that condition. (This -can also be a list of conditions.) +** Module functions can now install an optional finalizer that is +called when the function object is garbage-collected. Use +'set_function_finalizer' to set the finalizer and +'get_function_finalizer' to retrieve it. ---- -** The new function 'byte-compile-info-message' can be used to output -informational messages that look pleasing during the Emacs build. - ---- -** New 'help-fns-describe-variable-functions' hook. -It makes it possible to add metadata information to 'describe-variable'. - -** i18n (internationalization) - ---- -*** 'ngettext' can be used now to return the right plural form -according to the given numeric value. - -+++ -** 'inhibit-null-byte-detection' is renamed to 'inhibit-nul-byte-detection'. - -+++ -** 'self-insert-command' takes the char to insert as (optional) argument. - -+++ -** 'lookup-key' can take a list of keymaps as argument. - -+++ -** 'condition-case' now accepts t to match any error symbol. - -+++ -** New function 'proper-list-p'. -Given a proper list as argument, this predicate returns its length; -otherwise, it returns nil. 'format-proper-list-p' is now an obsolete -alias for the new function. - ---- -** 'define-minor-mode' automatically documents the meaning of ARG. - -+++ -** The function 'recenter' now accepts an additional optional argument. -By default, calling 'recenter' will not redraw the frame even if -'recenter-redisplay' is non-nil. Call 'recenter' with the new second -argument non-nil to force redisplay per 'recenter-redisplay's value. - -+++ -** New functions 'major-mode-suspend' and 'major-mode-restore'. -Use them when switching temporarily to another major mode, e.g. for -'hexl-mode', or to switch between 'c-mode' and 'image-mode' in XPM. - -+++ -** New macro 'dolist-with-progress-reporter'. -This works like 'dolist', but reports progress similar to -'dotimes-with-progress-reporter'. - -+++ -** New hook 'after-delete-frame-functions'. -This works like 'delete-frame-functions', but runs after the frame to -be deleted has been made dead and removed from the frame list. - ---- -** The function 'provided-mode-derived-p' was extended to support aliases. -The function now returns non-nil when the argument MODE is derived -from any alias of any of MODES. - -+++ -** New frame focus state inspection interface. -The hooks 'focus-in-hook' and 'focus-out-hook' are now obsolete. -Instead, attach to 'after-focus-change-function' using 'add-function' -and inspect the focus state of each frame using 'frame-focus-state'. - -+++ -** Emacs now requests and recognizes focus-change notifications from TTYs. -On terminal emulators that support the feature, Emacs can now support -'focus-in-hook' and 'focus-out-hook' for TTY frames. - -+++ -** Window-specific face remapping. -Face specifications (of the kind used in 'face-remapping-alist') -now support filters, allowing faces to vary between different windows -displaying the same buffer. See the node "(elisp) Face Remapping" -of the Emacs Lisp Reference manual for more detail. - -+++ -** Window change functions have been redesigned. -Hooks reacting to window changes run now only when redisplay detects -that a change has actually occurred. Six hooks are now provided: -'window-buffer-change-functions' (run after window buffers have -changed), 'window-size-change-functions' (run after a window was -assigned a new buffer or size), 'window-configuration-change-hook' -(like the former but run also when a window was deleted), -'window-selection-change-functions' (run when the selected window -changed) and 'window-state-change-functions' and -'window-state-change-hook' (run when any of the preceding ones is -run). Applications can enforce running the latter two using the new -function 'set-frame-window-state-change'. 'window-scroll-functions' -are unaffected by these changes. - -In addition, a number of functions now allow the caller to detect what -has changed since last redisplay: 'window-old-buffer' returns for any -window the buffer it showed at that time. 'old-selected-window' and -'old-selected-frame' return the window and frame that were selected -during last redisplay. 'window-old-pixel-width' (renamed from -'window-pixel-width-before-size-change'), 'window-old-pixel-height' -(renamed from 'window-pixel-height-before-size-change'), -'window-old-body-pixel-width' and 'window-old-body-pixel-height' -return the total and body sizes of any window during last redisplay. - -Also 'run-window-configuration-change-hook' is declared obsolete. - -See the section "(elisp) Window Hooks" in the Elisp manual for a -detailed explanation of the new behavior. - -+++ -** Scroll bar and fringe settings can now be made persistent for windows. -The functions 'set-window-scroll-bars' and 'set-window-fringes' now -have a new optional argument that makes the settings they produce -reliably survive subsequent invocations of 'set-window-buffer'. - -+++ -** New user option 'resize-mini-frames'. -This option allows automatically resizing minibuffer-only frames -similarly to how minibuffer windows are resized on "normal" frames. - -+++ -** New buffer display action function 'display-buffer-in-direction'. -This function allows specifying the location of the window chosen by -'display-buffer' in various ways. - -+++ -** New buffer display action alist entry 'dedicated'. -Such an entry allows specifying the dedicated status of a window -created by 'display-buffer'. - -+++ -** New buffer display action alist entry 'window-min-height'. -Such an entry allows specifying a minimum height of the window used -for displaying a buffer. 'display-buffer-below-selected' is the only -action function to respect it at the moment. - -+++ -** New buffer display action alist entry 'direction'. -This entry is used to specify the location of the window chosen by -'display-buffer-in-direction'. - -+++ -** Additional meaning of display action alist entry 'window'. -A 'window' entry can now also specify a reference window for -'display-buffer-in-direction'. - -+++ -** The function 'assoc-delete-all' now takes an optional predicate argument. - -+++ -** New function 'string-distance' to calculate the Levenshtein distance -between two strings. - -+++ -** 'print-quoted' now defaults to t, so if you want to see -'(quote x)' instead of 'x you will have to bind it to nil where applicable. - -+++ -** Numbers formatted via '%o' or '%x' are now formatted as signed integers. -This avoids problems in calls like '(read (format "#x%x" -1))', and is -more compatible with bignums. To get the traditional machine-dependent -behavior, set the experimental variable 'binary-as-unsigned' to t, -and if the new behavior breaks your code please email -<32252@debbugs.gnu.org>. Because '%o' and '%x' can now format signed -integers, they now support the '+' and space flags. - -+++ -** In Emacs Lisp mode, symbols with confusable quotes are highlighted. -For example, the first character in '‘foo' would be highlighted in -'font-lock-warning-face'. - -+++ -** Omitting variables after '&optional' and '&rest' is now allowed. -For example '(defun foo (&optional))' is no longer an error. This is -sometimes convenient when writing macros. See the ChangeLog entry -titled "Allow '&rest' or '&optional' without following variable -(Bug#29165)" for a full listing of which arglists are accepted across -versions. - ---- -** Internal parsing commands now use 'syntax-ppss' and disregard -'open-paren-in-column-0-is-defun-start'. This affects mostly things like -'forward-comment', 'scan-sexps', and 'forward-sexp' when parsing backward. -The new variable 'comment-use-syntax-ppss' can be set to nil to recover -the old behavior if needed. -This also means that there is no longer any need to precede opening -brackets at the start of a line inside documentation strings with a -backslash, although there is no harm in doing so to make the code -easier to edit with an older Emacs version. - ---- -** The 'server-name' and 'server-socket-dir' variables are set when a -socket has been passed to Emacs. - ---- -** The 'file-system-info' function is now available on all platforms. -instead of just Microsoft platforms. This fixes a 'get-free-disk-space' -bug on OS X 10.8 and later. - ---- -** The function 'get-free-disk-space' returns now a non-nil value for -remote systems, which support this check. - -+++ -** 'memory-limit' now returns a better estimate of memory consumption. - -+++ -** When interpreting 'gc-cons-percentage', Emacs now estimates the -heap size more often and (we hope) more accurately. E.g., formerly -'(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2)' continued to use -the 0.8 value during BODY2 until the next garbage collection, but that -is no longer true. Applications may need to re-tune their GC tricks. - -+++ -** New macro 'combine-change-calls' arranges to call the change hooks -('before-change-functions' and 'after-change-functions') just once -each around a sequence of lisp forms, given a region. This is -useful when a function makes a possibly large number of repetitive -changes and the change hooks are time consuming. - -+++ -** 'eql', 'make-hash-table', etc. now treat NaNs consistently. -Formerly, some of these functions ignored signs and significands of -NaNs. Now, all these functions treat NaN signs and significands as -significant. For example, '(eql 0.0e+NaN -0.0e+NaN)' now returns nil -because the two NaNs have different signs; formerly it returned t. -Also, Emacs now reads and prints NaN significands; e.g., if X is a -NaN, '(format "%s" X)' now returns "0.0e+NaN", "1.0e+NaN", etc., -depending on X's significand. - -+++ -** The function 'make-string' accepts an additional optional argument. -If the optional third argument is non-nil, 'make-string' will produce -a multibyte string even if its second argument is an ASCII character. - ---- -** '(format "%d" X)' no longer mishandles a floating-point number X that -does not fit in a machine integer. - ---- -** New coding-system 'ibm038'. -This is the International EBCDIC encoding, also available as aliases -'ebcdic-int' and 'cp038'. - ---- -** New JSON parsing and serialization functions 'json-serialize', -'json-insert', 'json-parse-string', and 'json-parse-buffer'. These -are implemented in C using the Jansson library. - -+++ -** New function 'ring-resize'. -'ring-resize' can be used to grow or shrink a ring. - -+++ -** New function 'flatten-tree'. -'flatten-list' is provided as an alias. These functions take a tree -and 'flatten' it such that the result is a list of all the terminal -nodes. - -+++ -** 'zlib-decompress-region' can partially decompress corrupted data. -If the new optional ALLOW-PARTIAL argument is passed, then the data -that was decompressed successfully before failing will be inserted -into the buffer. - -** Image mode - ---- -*** New library Exif. -An Exif library has been added that can parse JPEG files and output -data about creation times and orientation and the like. -'exif-parse-file' and 'exif-parse-buffer' are the main interface -functions. - ---- -*** 'image-mode' now uses this library to automatically rotate images -according to the orientation in the Exif data, if any. - ---- -*** New library image-converter. -If you need to view exotic image formats for which Emacs doesn't have -native support, customize the new user option -'image-use-external-converter' to t. If your system has -GraphicsMagick, ImageMagick or 'ffmpeg' installed, they will then be -used to convert images automatically before displaying them. - ---- -*** 'auto-mode-alist' now includes many of the types typically -supported by the external image converters, like WEPB, BMP and ICO. -These now default to using 'image-mode'. - ---- -*** 'imagemagick-types-inhibit' disables using ImageMagick by default. -'image-mode' started using ImageMagick by default for all images -some years back. It now respects 'imagemagick-types-inhibit' as a way -to disable that. - ---- -*** Some 'image-mode' variables are now buffer-local. -The image parameters 'image-transform-rotation', -'image-transform-scale' and 'image-transform-resize' are now declared -buffer-local, so each buffer could have its own values for these -parameters. - -+++ -*** Three new 'image-mode' commands have been added: 'm', which marks -the file in the dired buffer(s) for the directory the file is in; 'u', -which unmarks the file; and 'w', which pushes the current buffer's file -name to the kill ring. - -+++ -*** The command 'image-rotate' now accepts a prefix argument. -With a prefix argument, 'image-rotate' now rotates the image at point -90 degrees counter-clockwise, instead of the default clockwise. - -** Modules - ---- -*** The function 'load' now behaves correctly when loading modules. -Specifically, it puts the module name into 'load-history', prints -loading messages if requested, and protects against recursive loads. - -+++ -*** New module environment function 'process_input' to process user -input while module code is running. - -+++ -*** New module environment functions 'make_time' and 'extract_time' to -convert between timespec structures and Emacs Lisp time values. - -+++ -*** New module environment functions 'make_big_integer' and -'extract_big_integer' to create and extract arbitrary-size integer -values. - -+++ -*** emacs-module.h now defines a macro 'EMACS_MAJOR_VERSION' that expands -to the major version of the latest Emacs supported by the header. - -+++ -** The function 'read-variable' now uses its own history list. -The history of variable names read by 'read-variable' is recorded in -the new variable 'custom-variable-history'. - ---- -** The functions 'string-to-unibyte' and 'string-to-multibyte' are no -longer declared obsolete. We have found that there are legitimate use -cases for these functions, where there's no better alternative. We -believe that the incorrect uses of these functions all but disappeared -by now, so we are un-obsoleting them. - -+++ -** New function 'group-name' returns a group name corresponding to GID. - -+++ -** 'make-process' now takes a keyword argument ':file-handler'; if -that is non-nil, it will look for a file name handler for the current -buffer's 'default-directory' and invoke that file name handler to make -the process. That way 'make-process' can start remote processes. - -+++ -** '(locale-info 'paper)' now returns the paper size on systems that support it. -This is currently supported on GNUish hosts and on modern versions of -MS-Windows. - -+++ -** The function 'regexp-opt', when given an empty list of strings, now -returns a regexp that never matches anything, which is an identity for -this operation. Previously, the empty string was returned in this -case. - -+++ -** New constant 'regexp-unmatchable' contains a never-matching regexp. -It is a convenient and readable way to specify a regexp that should -not match anything, and is as fast as any such regexp can be. - -+++ -** New functions to handle the URL variant of base-64 encoding. -New functions 'base64url-encode-string' and 'base64url-encode-region' -implement the url-variant of base-64 encoding as defined in RFC4648. - -The functions 'base64-decode-string' and 'base64-decode-region' now -accept an optional argument to decode the URL variant of base-64 -encoding. - -+++ -** The function 'file-size-human-readable' accepts more optional arguments. -The new third argument is a string put between the number and unit; it -defaults to the empty string. The new fourth argument is a string -representing the unit to use; it defaults to "B" when the second -argument is 'iec' and the empty string otherwise. We recommend a -space or non-breaking space as third argument, and "B" as fourth -argument, circumstances allowing. - -+++ -** 'format-spec' has been expanded with several modifiers to allow -greater flexibility when customizing variables. The modifiers include -zero-padding, upper- and lower-casing, and limiting the length of the -interpolated strings. The function has now also been documented in -the Emacs Lisp manual. - -+++ -** 'directory-files-recursively' can now take an optional PREDICATE -parameter to control descending into subdirectories, and a -FOLLOW-SYMLINK parameter to say that symbolic links that point to -other directories should be followed. - -+++ -** New function 'xor' returns the boolean exclusive-or of its args. -The function was previously defined in array.el, but has been moved to -subr.el so that it is available by default. It now always returns the -non-nil argument when the other is nil. Several duplicates of 'xor' -in other packages are now obsolete aliases of 'xor'. - -+++ -** 'define-globalized-minor-mode' now takes BODY forms. - -+++ -** New text property 'help-echo-inhibit-substitution'. -Setting this on the first character of a help string disables -conversions via 'substitute-command-keys'. - -+++ -** New text property 'minibuffer-message'. -Setting this on a character of the minibuffer text will display the -temporary echo messages before that character, when messages need to -be displayed while minibuffer is active. - -+++ -** 'undo' can be made to ignore the active region for a command -by setting 'undo-inhibit-region' symbol property of that command to -non-nil. This is used by 'mouse-drag-region' to make the effect -easier to undo immediately afterwards. - ---- -** When called interactively, 'next-buffer' and 'previous-buffer' now -signal 'user-error' if there is no buffer to switch to. +** 'parse-time-string' can now parse ISO 8601 format strings, +such as "2020-01-15T16:12:21-08:00". -* Changes in Emacs 27.1 on Non-Free Operating Systems - ---- -** Battery status is now supported in all Cygwin builds. -Previously it was supported only in the Cygwin-w32 build. - -** Emacs now handles key combinations involving the macOS "command" -and "option" modifier keys more correctly. - -** MacOS modifier key behavior is now more adjustable. -The behavior of the macOS "Option", "Command", "Control" and -"Function" keys can now be specified separately for use with -ordinary keys, function keys and mouse clicks. This allows using them -in their standard macOS way for composing characters. - -** The special handling of 'frame-title-format' on NS where setting it -to t would enable the macOS proxy icon has been replaced with a -separate variable, 'ns-use-proxy-icon'. 'frame-title-format' will now -work as on other platforms. - ---- -** New primitive 'w32-read-registry'. -This primitive lets Lisp programs access the MS-Windows Registry by -retrieving values stored under a given key. It is intended to be used -for supporting features such as XDG-like location of important files -and directories. +* Changes in Emacs 28.1 on Non-Free Operating Systems +++ -** The default value of 'w32-pipe-read-delay' is now zero. -This speeds up reading output from sub-processes that produce a lot of -data. - -This variable may need to be non-zero only when running DOS programs -as Emacs subprocesses, which by now is not supported on modern -versions of MS-Windows. Set this variable to 50 if for some reason -you need the old behavior (and please report such situations to Emacs -developers). - ---- -** New variable 'w32-multibyte-code-page'. -This variable holds the value of the multibyte code page used by the -system. It is usually zero, which indicates that 'w32-ansi-code-page' -is being used, except in Far Eastern locales. When this variable is -non-zero, Emacs at startup sets 'locale-coding-system' to the -corresponding encoding, instead of using 'w32-ansi-code-page'. - ---- -** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows. -Experience shows that compacting font caches causes more trouble on -MS-Windows than it helps. - -+++ -** Font lookup on MS-Windows was improved to support rare scripts. -To activate the improvement, run the new function -'w32-find-non-USB-fonts' once per Emacs session, or assign to the new -variable 'w32-non-USB-fonts' the list of scripts and the corresponding -fonts. See the documentation of this function and variable in the -Emacs manual for more details. - -+++ -** On NS the behavior of drag and drop can now be modified by use of -modifier keys in line with Apples guidelines. This makes the drag and -drop behavior more consistent, as previously the sending application -was able to 'set' modifiers without the knowledge of the user. - -** On NS multicolor font display is enabled again since it is also -implemented in Emacs on free operating systems via Cairo drawing. +** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. +'module-file-suffix' now has the value ".dylib" on macOS, but the +".so" suffix is supported as well. ---------------------------------------------------------------------- diff --git a/etc/NEWS.27 b/etc/NEWS.27 new file mode 100644 index 00000000000..380ac71260d --- /dev/null +++ b/etc/NEWS.27 @@ -0,0 +1,3693 @@ +GNU Emacs NEWS -- history of user-visible changes. + +Copyright (C) 2017-2020 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. +If possible, use 'M-x report-emacs-bug'. + +This file is about changes in Emacs version 27. + +See file HISTORY for a list of GNU Emacs versions and release dates. +See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes +in older Emacs versions. + +You can narrow news to a specific version by calling 'view-emacs-news' +with a prefix argument or by typing 'C-u C-h C-n'. + +Temporary note: ++++ indicates that all relevant manuals in doc/ have been updated. +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it +applies, and please also update docstrings as needed. + + +* Installation Changes in Emacs 27.1 + +--- +** Emacs now uses GMP, the GNU Multiple Precision library. +By default, if 'configure' does not find a suitable libgmp, it +arranges for the included mini-gmp library to be built and used. +The new 'configure' option '--without-libgmp' uses mini-gmp even if a +suitable libgmp is available. + +--- +** Emacs can now use HarfBuzz as its shaping engine. +The new configure option '--with-harfbuzz' adds support for the +HarfBuzz text shaping engine. It is on by default; use './configure +--without-harfbuzz' to build without it. The HarfBuzz text shaping is +available via new font backend drivers 'xfthb' and 'ftcrhb' for Xft +and Cairo drawings, respectively, and via the 'harfbuzz' backend on +MS-Windows. The HarfBuzz text shaping is preferred to the previously +supported ones, so the font backends that use older shaping engines +(FLT on GNU and Unix systems and Uniscribe on MS-Windows) are not +enabled by default; they can be enabled via the 'font-backend' frame +parameter or via X resources. + +--- +** The new configure option '--with-json' adds native support for JSON. +This uses the Jansson library. The option is on by default; use +'./configure --with-json=no' to build without Jansson support. The +new JSON functions 'json-serialize', 'json-insert', +'json-parse-string', and 'json-parse-buffer' are typically much faster +than their Lisp counterparts from json.el. + +--- +** The configure option '--with-cairo' is no longer experimental. +This builds Emacs with Cairo drawing, and supports built-in printing +when Emacs is built with GTK+. Some severe bugs in this build were +fixed, and we can therefore offer this to users without caveats. Note +that building with Cairo enabled results in using Pango instead of +libXft for font support, and that Pango 1.44 has removed support for +bitmapped fonts. + ++++ +** Emacs now uses a "portable dumper" instead of unexec. +This improves compatibility with memory allocation on modern systems, +and in particular better supports the Address Space Layout +Randomization (ASLR) feature, a security technique used by most modern +operating systems. + +When built with the portable dumping support (which is the default), +Emacs looks for the "emacs.pdmp" file, generated during the build, in +its data directory at startup, and loads the dumped state from there. +The new command-line argument '--dump-file=FILE' allows specifying a +non-default ".pdmp" file to load the state from; see the node +"(emacs) Initial Options" in the Emacs manual for more information. + +An Emacs started via a dump file can create a new dump file only if it +was invoked with the '-batch' option. (This is a temporary +limitation; we plan on lifting it in a future release.) + +Although the portable dumper has been tested, it may have a bug on +unusual platforms. If you require traditional unexec dumping you can +use the configure-time option '--with-dumping=unexec'; however, please +file a bug report describing the situation, as unexec dumping is +deprecated, and we plan on removing it in some future release. + +--- +** The new configure option '--enable-checking=structs' attempts to +check that the portable dumper code has been updated to match the last +change to one of the data structures that it relies on. + +--- +** The configure options '--enable-checking=conslist' and +'--enable-checking=xmallocoverrun' have been withdrawn. The former +made Emacs irredeemably slow, and the latter made it crash. Neither +option was useful with modern debugging tools such as AddressSanitizer. +(See "etc/DEBUG" for the details of using the modern replacements of the +removed configure options.) + +--- +** Emacs no longer defaults to using ImageMagick to display images. +This is due to security and stability concerns with ImageMagick. To +override the default, use 'configure --with-imagemagick'. + +--- +** Several configure options now accept an option-argument 'ifavailable'. +For example, './configure --with-xpm=ifavailable' now configures Emacs +to attempt to use libxpm but to continue building even if libxpm is +absent. The other affected options are '--with-gif', '--with-gnutls', +'--with-jpeg', '--with-png', and '--with-tiff'. + +--- +** The 'etags' program now uses the C library's regular expression matcher. +If it's possible, 'etags' will use the regexp matcher from the +system's standard C library, otherwise it will be linked with a +compatible regex substitute. This lets developers maintain Emacs's +own regex code without having to also support other programs. The new +configure option '--without-included-regex' forces 'etags' to use the C +library's regex matcher even if the regex substitute ordinarily would +be used to work around compatibility problems. + +--- +** Emacs has been ported to the '-fcheck-pointer-bounds' option of GCC. +This causes Emacs to check bounds of some arrays addressed by its +internal pointers, which can be helpful when debugging the Emacs +interpreter or modules that it uses. If your platform supports it you +can enable it when configuring, e.g., './configure CFLAGS="-g3 -O2 +-mmpx -fcheck-pointer-bounds"' on Intel MPX platforms. + +--- +** Emacs now normally uses a C pointer type instead of a C integer +type to implement Lisp_Object, which is the fundamental machine word +type internal to the Emacs Lisp interpreter. This change aims to +catch typos and supports '-fcheck-pointer-bounds'. The 'configure' +option '--enable-check-lisp-object-type' is therefore no longer as +useful and so is no longer enabled by default in developer builds, +to reduce differences between developer and production builds. + +--- +** The distribution tarball now has test cases; 'make check' runs them. +This is intended mostly to help developers. + +--- +** Emacs now requires GTK 2.24 and GTK 3.10 for the GTK 2 and GTK 3 +builds respectively. + +--- +** New make target 'help' shows a summary of common make targets. + +--- +** Emacs now builds with dynamic module support by default. +Pass '--without-modules' to 'configure' to disable dynamic module +support. + +--- +** The ftx font backend driver is now obsolete and will be removed in +Emacs 28. + + +* Startup Changes in Emacs 27.1 + ++++ +** Emacs can now use the XDG convention for init files. +The 'XDG_CONFIG_HOME' environment variable (which defaults to +"~/.config") specifies the XDG configuration parent directory. Emacs +checks for "init.el" and other configuration files inside the "emacs" +subdirectory of 'XDG_CONFIG_HOME', i.e. "$XDG_CONFIG_HOME/emacs/init.el" + +However, Emacs will still initially look for init files in their +traditional locations if "~/.emacs.d" or "~/.emacs" exist, even if +"$XDG_CONFIG_HOME/emacs" also exists. This means that you must delete +or rename any existing "~/.emacs.d" and "~/.emacs" to enable use of +the XDG directory. + +If "~/.emacs.d" does not exist, and Emacs has decided to use it +(i.e. "$XDG_CONFIG_HOME/emacs" does not exist), Emacs will create it. +Emacs will never create "$XDG_CONFIG_HOME/emacs". + +Whichever directory Emacs decides to use, it will set +'user-emacs-directory' to point to it. + ++++ +** Emacs can now be configured using an early init file. +The file is called "early-init.el", in 'user-emacs-directory'. It is +loaded very early in the startup process: before graphical elements +such as the tool bar are initialized, and before the package manager +is initialized. The primary purpose is to allow customizing how the +package system is initialized given that initialization now happens +before loading the regular init file (see below). + +We recommend against putting any customizations in this file that +don't need to be set up before initializing installed add-on packages, +because the early init file is read too early into the startup +process, and some important parts of the Emacs session, such as +'window-system' and other GUI features, are not yet set up, which could +make some customization fail to work. + ++++ +** Installed packages are now activated *before* loading the init file. +As a result of this change, it is no longer necessary to call +'package-initialize' in your init file. + +Previously, a call to 'package-initialize' was automatically inserted +into the init file when Emacs was started. This call can now safely +be removed. Alternatively, if you want to ensure that your init file +is still compatible with earlier versions of Emacs, change it to: + +(when (< emacs-major-version 27) + (package-initialize)) + +However, if your init file changes the values of 'package-load-list' +or 'package-user-dir', or sets 'package-enable-at-startup' to nil then +it won't work right without some adjustment: +- You can move that code to the early init file (see above), so those + settings apply before Emacs tries to activate the packages. +- You can use the new 'package-quickstart' so activation of packages + does not need to pay attention to 'package-load-list' or + 'package-user-dir' any more. + +--- +** Emacs now notifies systemd when startup finishes or shutdown begins. +Units that are ordered after 'emacs.service' will only be started +after Emacs has finished initialization and is ready for use. +(If your Emacs is installed in a non-standard location and you copied the +emacs.service file to e.g. "~/.config/systemd/user/", you will need to copy +the new version of the file again.) + + +* Changes in Emacs 27.1 + ++++ +** Emacs now supports resizing and rotating images without ImageMagick. +All modern systems support this feature. (On GNU and Unix systems, +Cairo drawing or the XRender extension to X11 is required for this to +be available; the configure script will test for it and, if found, +enable scaling.) + +The new function 'image-transforms-p' can be used to test whether any +given frame supports these capabilities. + ++++ +** The Network Security Manager now allows more fine-grained control +of what checks to run via the 'network-security-protocol-checks' +user option. + ++++ +** TLS connections have their security tightened by default. +Most of the checks for outdated, believed-to-be-weak TLS algorithms +and ciphers are now switched on by default. (In addition, several new +TLS weaknesses are now warned about.) By default, the NSM will +flag connections using these weak algorithms and ask users whether to +allow them. To get the old behavior back (where certificates are +checked for validity, but no warnings about weak cryptography are +issued), you can either set 'network-security-protocol-checks' to nil, +or adjust the elements in that user option to only happen on the 'high' +security level (assuming you use the 'medium' level). + +--- +** New user option 'nsm-trust-local-network'. +Allows skipping Network Security Manager checks for hosts on your +local subnet(s). It defaults to nil. Usually, there should be no +need to set this non-nil, and doing that risks opening your local +network connections to attacks. So be sure you know what you are +doing before changing the value. + ++++ +** Native GnuTLS connections can now use client certificates. +Previously, this support was only available when using the external +'gnutls-cli' command. Call 'open-network-stream' with +':client-certificate t' to trigger looking up of per-server +certificates via 'auth-source'. + ++++ +** New user option 'network-stream-use-client-certificates'. +When non-nil, 'open-network-stream' performs lookups of client +certificates using 'auth-source' as if ':client-certificate t' were +specified if there is no explicit ':client-certificate' parameter. +Defaults to nil. + ++++ +** 'next/previous-multiframe-window' have been renamed. +The new names are as follows: + + 'next-multiframe-window' -> 'next-window-any-frame' + 'previous-multiframe-window' -> 'previous-window-any-frame' + +The old function names are maintained as aliases for backward +compatibility. + +** emacsclient ++++ +*** emacsclient now supports the 'EMACS_SOCKET_NAME' environment variable. +The command-line argument '--socket-name' overrides it. +(The same behavior as for the pre-existing 'EMACS_SERVER_FILE' variable.) + ++++ +*** Emacs and emacsclient now default to "$XDG_RUNTIME_DIR/emacs". +This is used as the directory for client/server sockets, if Emacs is +running on a platform or environment that sets the 'XDG_RUNTIME_DIR' +environment variable to indicate where session sockets should go. +To get the old, less-secure behavior, you can set the +'EMACS_SOCKET_NAME' environment variable to an appropriate value. + +--- +*** When run by root, emacsclient no longer connects to non-root sockets. +(Instead you can use Tramp methods to run root commands in a non-root Emacs.) + +--- +** 'xft-ignore-color-fonts' now ignores even more color fonts. +There are color fonts that managed to bypass the existing checks, +causing XFT crashes, they are now filtered out. Setting +'xft-ignore-color-fonts' to nil removes those checks, which might +require setting 'face-ignored-fonts' to filter out problematic fonts. +Known problematic fonts are "Noto Color Emoji" and "Emoji One". + +--- +** The GTK+ font chooser now respects 'face-ignored-fonts'. +When using 'menu-set-font' under GTK3, the available fonts are now +matched against 'face-ignored-fonts'. + +--- +** The GTK+ font chooser now remembers the previously selected settings. +It now remembers the name, size, style, etc. + ++++ +** New user option 'what-cursor-show-names'. +When non-nil, 'what-cursor-position' will show the name of the character +in addition to the decimal/hex/octal representation. Default nil. + ++++ +** New function 'network-lookup-address-info'. +This does IPv4 and/or IPv6 address lookups on hostnames. + ++++ +** 'network-interface-list' can now return IPv4 and IPv6 addresses. +IPv4 and IPv6 addresses are now returned by default if available, +optionally including netmask/broadcast address information. + +--- +** Control of the threshold for using the 'distant-foreground' color. +The threshold for color distance below which the 'distant-foreground' +color of the face will be used instead of the foreground color can now +be controlled via the new variable 'face-near-same-color-threshold'. +The default value is 30000, as the previously hard-coded threshold. + ++++ +** The function 'read-passwd' uses "*" as default character to hide passwords. + +** The function 'read-answer' now accepts not only single character +answers, but also function keys like 'F1', character events such as +'C-M-h', and control characters like 'C-h'. + +** Lexical binding is now used when evaluating interactive Elisp forms. +More specifically, 'lexical-binding' is now used for 'M-:', '--eval', +as well as in 'lisp-interaction-mode' and 'ielm-mode', used in the +"*scratch*" and "*ielm*" buffers. + +--- +** The new user option 'tooltip-resize-echo-area' avoids truncating +tooltip text on GUI frames when tooltips are displayed in the echo +area. Instead, it resizes the echo area as needed to accommodate the +full tool-tip text. + +--- +** Show mode line tooltips only if the corresponding action applies. +Customize the user option 'mode-line-default-help-echo' to restore the +old behavior where the tooltip text is also shown when the +corresponding action does not apply. + ++++ +** New hook 'server-after-make-frame-hook'. +This hook is a convenient place to perform initializations in daemon +mode which require GUI features to be available. One example is +restoration of the previous session using the desktop.el package: put +the call to 'desktop-read' in this hook, if you want the GUI settings +to be restored, or if desktop.el needs to interact with you during +restoration of the session. + ++++ +** The functions 'set-frame-height' and 'set-frame-width' are now +commands, and will set the currently selected frame to the height/ +width specified by the numeric prefix. + ++++ +** New function 'logcount' calculates an integer's Hamming weight. + ++++ +** New function 'libxml-available-p'. +This function returns non-nil if libxml support is both compiled in +and available at run time. Lisp programs should use this function to +detect built-in libxml support, instead of testing for that +indirectly, e.g., by checking that functions like +'libxml-parse-html-region' return nil. + ++++ +** 'libxml-parse-xml-region' and 'libxml-parse-html-region' take +a parameter that's called DISCARD-COMMENTS, but it really only +discards the top-level comment. Therefore this parameter is now +obsolete, and the new utility function 'xml-remove-comments' can be +used to remove comments before calling the libxml functions to parse +the data. + ++++ +** A new DOM (the XML/HTML document structure returned by functions +such as 'libxml-parse-html-region') traversal function has been added: +'dom-search', which takes a DOM and a predicate and returns all nodes +that match. + ++++ +** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'. +It blocks line breaking after a one-letter word, also in the case when +this word is preceded by a non-space, but non-alphanumeric character. + ++++ +** The limit on repetitions in regexps has been raised to 2^16-1. +It was previously limited to 2^15-1. For example, the following +regular expression was previously invalid, but is now accepted: + + x\{32768\} + +--- +** The German prefix and postfix input methods now support Capital sharp S. + +--- +** New input methods 'hawaiian-postfix' and 'hawaiian-prefix'. + +--- +** New input methods 'georgian-qwerty' and 'georgian-nuskhuri'. + +--- +** New input methods for several variants of the Sami language. +The Sami input methods include: 'norwegian-sami-prefix', +'bergsland-hasselbrink-sami-prefix', 'southern-sami-prefix', +'ume-sami-prefix', 'northern-sami-prefix', 'inari-sami-prefix', +'skolt-sami-prefix', and 'kildin-sami-prefix'. + ++++ +** Japanese environments use UTF-8 by default. +In Japanese environments that do not specify encodings and are not +based on MS-Windows, the default encoding is now utf-8 instead of +japanese-iso-8bit. + ++++ +** New function 'exec-path'. +This function by default returns the value of the corresponding +user option, but can optionally return the equivalent of 'exec-path' +from a remote host. + ++++ +** The function 'executable-find' supports an optional argument REMOTE. +This triggers searching for the program on the remote host as indicated by +'default-directory'. + ++++ +** New user option 'auto-save-no-message'. +When set to t, no message will be shown when auto-saving (default +value: nil). + +--- +** The value of 'make-cursor-line-fully-visible' can now be a function. +In addition to nil or non-nil, the value can now be a predicate +function. Follow mode uses this to control scrolling of its windows +when the last screen line in a window is not fully visible. + ++++ +** New variable 'emacs-repository-branch'. +It reports the git branch from which Emacs was built. + ++++ +** New user option 'switch-to-buffer-obey-display-actions'. +When non-nil, 'switch-to-buffer' uses 'pop-to-buffer-same-window' that +respects display actions specified by 'display-buffer-alist' and +'display-buffer-overriding-action'. + ++++ +** The user option 'switch-to-visible-buffer' is now obsolete. +Customize 'switch-to-prev-buffer-skip' instead. + ++++ +** New user option 'switch-to-prev-buffer-skip'. +This user option allows specifying the set of buffers that may be +shown by 'switch-to-prev-buffer' and 'switch-to-next-buffer' more +stringently than the now obsolete 'switch-to-visible-buffer'. + +** New 'flex' completion style. +An implementation of popular "flex/fuzzy/scatter" completion which +matches strings where the pattern appears as a subsequence. Put +simply, makes "foo" complete to both "barfoo" and "frodo". Add 'flex' +to 'completion-styles' or 'completion-category-overrides' to use it. + +** The 'completion-common-part' face is now visible by default. + ++++ +** New face attribute ':extend' to control face extension at EOL. +The new face attribute ':extend' controls whether to use the face for +displaying the empty space beyond end of line (EOL) till the edge of +the window. By default, this attribute is non-nil only for a small +number of faces, notably, 'region'; any other face that crosses end of +line will not affect the display of the empty space at EOL. This is +to make Emacs behave more like other GUI applications with respect to +displaying faces that cross line boundaries. + +This attribute behaves specially when theme definitions are applied: +if the theme doesn't specify an explicit value of this attribute for a +face, the value from the original face definition is inherited. +Consequently, a theme generally shouldn't specify this attribute +unless it has a good reason to do so. + +** Connection-local variables ++++ +*** Connection-local variables are applied by default like file-local +and directory-local variables. + ++++ +*** The macro 'with-connection-local-variables' has been renamed from +'with-connection-local-profiles'. No argument PROFILES needed any longer. + +--- +** New user option 'next-error-verbose' controls when 'next-error' +outputs a message about the error locus. + +--- +** New user option 'grep-search-path' defines the directories searched for +grep hits (this used to be controlled by 'compilation-search-path'). + +--- +** New user option 'emacs-lisp-compilation-search-path' defines the +directories searched for byte-compiler error messages (this used to +be controlled by 'compilation-search-path'). + +--- +** Multicolor fonts such as "Noto Color Emoji" can be displayed on +Emacs configured with Cairo drawing and linked with cairo >= 1.16.0. + ++++ +** Emacs now optionally displays a fill column indicator. +This is similar to what 'fill-column-indicator' package provides, but +much faster and compatible with 'show-trailing-whitespace'. + +Customize the buffer-local user options 'display-fill-column-indicator' +and 'display-fill-column-indicator-character' to activate the +indicator. + +The indicator is not displayed at all in minibuffer windows and +in tooltips, as it is not useful there. + +There are 2 new buffer local variables and 1 face to customize this +mode, they are described in the manual "(emacs) Display". + ++++ +** 'progress-reporter-update' now accepts an optional suffix string to display. + +--- +** New user option 'xref-file-name-display' controls the display of +file names in xref buffers. + +** New user option 'byte-count-to-string-function'. +It is used for displaying file sizes and disk space in some cases. + ++++ +** Emacs now interprets RGB triplets like HTML, SVG, and CSS do. +The X convention previously used differed slightly, particularly for +RGB triplets with a single hexadecimal digit per component. + +--- +** The toolbar now shows the equivalent key binding in its tooltips. + +--- +** The File menu-bar menu was re-arranged. +Print menu items moved to submenu, and also added the new entries for tabs. + +--- +** 'scroll-lock-mode' is now bound to the 'Scroll_Lock' key globally. +Note that this key binding will not work on MS-Windows systems if +'w32-scroll-lock-modifier' is non-nil. + +--- +** 'global-set-key', called interactively, now no longer downcases a +key binding with an upper case letter - if you can type it, you can +bind it. + ++++ +** 'read-from-minibuffer' now works with buffer-local history variables. +The HIST argument of 'read-from-minibuffer' now works correctly with +buffer-local variables. This means that different buffers can have +their own separated input history list if desired. + +** 'backup-by-copying-when-privileged-mismatch' applies to file gid, too. +In addition to checking the file owner uid, Emacs also checks that the +group gid is not greater than 'backup-by-copying-when-privileged-mismatch'; +if so, 'backup-by-copying-when-mismatch' will be forced on. + + +* Editing Changes in Emacs 27.1 + ++++ +** When asked to visit a large file, Emacs now offers to visit it literally. +Previously, Emacs would only ask for confirmation before visiting +large files. Now it also offers a third alternative: to visit the +file literally, as in 'find-file-literally', which speeds up +navigation and editing of large files. + ++++ +** 'zap-to-char' now uses the history of characters you used to zap to. +'zap-to-char' uses the new 'read-char-from-minibuffer' function to allow +navigating through the history of characters that have been input. +This is mostly useful for characters that have complex input methods +where inputting the character again may involve many keystrokes. + ++++ +** 'save-some-buffers' now has a new action in the prompt: 'C-f' will +exit the command and switch to the buffer currently being asked about. + +--- +** More commands support noncontiguous rectangular regions, namely +'upcase-dwim', 'downcase-dwim', 'capitalize-dwim', 'capitalize-region', +'upcase-initials-region', 'replace-string', 'replace-regexp', and +'delimit-columns-region'. + ++++ +** The new 'amalgamating-undo-limit' variable can be used to control +how many changes should be amalgamated when using the 'undo' command. + +--- +** The 'newline-and-indent' command (commonly bound to 'RET' in many +modes) now takes an optional numeric argument to specify how many +times is should insert newlines (and indent). + ++++ +** New command 'make-empty-file'. + +--- +** New variable 'x-wait-for-event-timeout'. +This controls how long Emacs will wait for updates to the graphical +state to take effect (making a frame visible, for example). + ++++ +** New user option 'electric-quote-replace-double'. +This option controls whether '"' is replaced in 'electric-quote-mode', +in addition to other quote characters. If non-nil, ASCII double-quote +characters that quote text "like this" are replaced by double +typographic quotes, “like thisâ€, in text modes, and in comments in +non-text modes. + +--- +** New user option 'flyspell-case-fold-duplications'. +This option controls whether Flyspell mode considers consecutive words +to be duplicates if they are not in the same case. If non-nil, the +default, words are considered to be duplicates even if their letters' +case does not match. + +--- +** 'write-abbrev-file' now includes special properties. +'write-abbrev-file' now writes special properties like ':case-fixed' +for abbrevs that have them. + ++++ +** 'write-abbrev-file' skips empty tables. +'write-abbrev-file' now skips inserting a 'define-abbrev-table' form for +tables which do not have any non-system abbrevs to save. + ++++ +** The new functions and commands 'text-property-search-forward' and +'text-property-search-backward' have been added. These provide an +interface that's more like functions like 'search-forward'. + +--- +** 'add-dir-local-variable' now uses dotted pair notation syntax to +write alists of variables to ".dir-locals.el". This is the same +syntax that you can see in the example of a ".dir-locals.el" file in +the node "(emacs) Directory Variables" of the user manual. + ++++ +** Network connections using 'local' can now use IPv6. +'make-network-process' now uses the correct loopback address when +asked to use ':host 'local' and ':family 'ipv6'. + ++++ +** The new function 'replace-region-contents' replaces the current +region using a given replacement-function in a non-destructive manner +(in terms of 'replace-buffer-contents'). + ++++ +** The command 'replace-buffer-contents' now has two optional +arguments mitigating performance issues when operating on huge +buffers. + ++++ +** Dragging 'C-M-mouse-1' now marks rectangular regions. + ++++ +** The command 'delete-indentation' now operates on the active region. +If the region is active, the command joins all the lines in the +region. When there's no active region, the command works on the +current and the previous or the next line, as before. + ++++ +** You can now change the font size with the mouse wheel. +Scrolling the mouse wheel with the Ctrl key pressed will now act the +same as the 'C-x C-+' and 'C-x C--' commands. + + +* Changes in Specialized Modes and Packages in Emacs 27.1 + +--- +** New HTML mode skeleton 'html-id-anchor'. +This new command (which inserts an <a id="foo">_</a> skeleton) is +bound to 'C-c C-c #'. + ++++ +** New command 'font-lock-refontify'. +This is an interactive convenience function to be used when developing +font locking for a mode. It recomputes the font locking data and then +re-fontifies the buffer. + +--- +** Font Lock is smarter about fontifying unterminated strings and comments. +When you type a quote that starts a string, or a comment delimiter +that starts a comment, font-lock will not immediately refontify the +following characters in 'font-lock-string-face' or +'font-lock-comment-face'. Instead, it will delay the fontification +beyond the current line to give you a chance to close the string or +comment. This is controlled by the new user option +'jit-lock-antiblink-grace', which specifies the delay in seconds. The +default is 2 seconds; set to nil to get back the old behavior. + +--- +** The 'C' command in 'tar-mode' will now preserve the timestamp of +the extracted file if the new user option 'tar-copy-preserve-time' is +non-nil. + +--- +** 'autoconf-mode' is now used instead of 'm4-mode' for the +"acinclude.m4" / "aclocal.m4" / "acsite.m4" files. + +--- +** On GNU/Linux, 'M-x battery' will now list all batteries, no matter +what they're named, and the 'battery-linux-sysfs-regexp' variable has +been removed. + +** The 'list-processes' command now includes port numbers in the +network connection information (in addition to the host name). + +** The 'cl' package is now officially deprecated in favor of 'cl-lib'. + +--- +** desktop + +*** When called interactively with a prefix arg 'C-u', 'desktop-read' +now prompts the user for the directory containing the desktop file. + ++++ +** display-line-numbers-mode + +*** New faces 'line-number-major-tick' and 'line-number-minor-tick', +and user options 'display-line-numbers-major-tick' and +'display-line-numbers-minor-tick' can be used to highlight the line +numbers of lines multiple of certain numbers. + +*** New variable 'display-line-numbers-offset', when non-zero, adds +an offset to absolute line numbers. + ++++ +** winner + +*** A new user option, 'winner-boring-buffers-regexp', has been added. + +** table + +*** 'table-generate-source' and friends now support outputting wiki and +mediawiki format tables. + +--- +** telnet-mode + +*** Reverting a buffer in 'telnet-mode' will restart a closed connection. + +** goto-addr + +*** A way to more conveniently specify what URI address schemes should +be ignored has been added via the 'goto-address-uri-schemes-ignored' +variable. + ++++ +** tex-mode + +*** 'latex-noindent-commands' controls indentation of certain commands. +You can use this new user option to control indentation of arguments of +\emph, \footnote, and similar commands. + +** byte compiler + +*** 'byte-compile-dynamic' is now obsolete. +This is because on the one hand it suffers from misbehavior in corner +cases that have plagued it for years, and on the other experiments indicated +that it doesn't bring any measurable benefit. + +--- +*** The 'g' keystroke in "*Compile-Log*" buffers has been bound to a +new command that will recompile the file previously compiled with 'M-x +byte-compile-file' and the like. + +** compile.el + +--- +*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can +be functions. + ++++ +*** 'compilation-context-lines' can now take the value t; this is like +nil, but instead of scrolling the current line to the top of the +screen when there is no left fringe, it inserts a visible arrow before +column zero. + +--- +*** The new 'compilation-transform-file-match-alist' user option can +be used to transform file name matches compilation output, and remove +known false positives being recognized as warnings/errors. + +** cl-lib.el + ++++ +*** 'cl-defstruct' has a new ':noinline' argument to prevent inlining +its functions. + ++++ +*** 'cl-defstruct' slots accept a ':documentation' property. + +--- +*** 'cl-values-list' will now signal an error if its argument isn't a list. + +** doc-view.el + +*** New commands 'doc-view-presentation' and 'doc-view-fit-window-to-page'. + +*** Added support for password-protected PDF files. + +*** A new user option 'doc-view-pdftotext-program-args' has been added +to allow controlling how the conversion to text is done. + +** Ido + +*** New user option 'ido-big-directories' to mark directories whose +names match certain regular expressions as big. Ido won't attempt to +list the contents of such directories when completing file names. + +** Minibuffer + ++++ +*** A new user option, 'minibuffer-beginning-of-buffer-movement', has +been introduced to allow controlling how the 'M-<' command works in +the minibuffer. If non-nil, point will move to the end of the prompt +(if point is after the end of the prompt). + ++++ +*** When the minibuffer is active, echo-area messages are displayed at +the end of the minibuffer instead of hiding the minibuffer by the echo +area display. The new user option 'minibuffer-message-clear-timeout' +controls how messages displayed in this situation are removed from the +minibuffer. + +--- +*** Minibuffer now uses 'minibuffer-message' to display error messages +at the end of the active minibuffer. + ++++ +*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer. + +--- +*** Some commands that previously used 'read-char-choice' now read +a character using the minibuffer by 'read-char-from-minibuffer'. + +** map.el + +*** Now also understands plists. +*** Now defined via generic functions that can be extended via 'cl-defmethod'. +*** Deprecate the 'map-put' macro in favor of a new 'map-put!' function. +*** 'map-contains-key' now returns a boolean rather than the key. +*** Deprecate the 'testfn' args of 'map-elt' and 'map-contains-key'. +*** New generic function 'map-insert'. ++++ +*** The 'type' arg can be a list '(hash-table :key1 VAL1 :key2 VAL2 ...)'. + +** seq.el +New convenience functions 'seq-first' and 'seq-rest' give easy access +to respectively the first and all but the first elements of sequences. + +The new predicate function 'seq-contains-p' should be used instead of +the now obsolete 'seq-contains'. + +--- +** Follow mode +In the current follow group of windows, "ghost" cursors are no longer +displayed in the non-selected follow windows. To get the old behavior +back, customize 'follow-hide-ghost-cursors' to nil. + ++++ +** New variable 'warning-fill-column' for 'display-warning'. + +** Windmove + +--- +*** 'windmove-create-window' when non-nil makes a new window. +This happens upon moving off the edge of the frame. + +--- +*** Windmove supports directional window display and selection. +The new command 'windmove-display-default-keybindings' binds default +keys with provided modifiers (by default, Shift-Meta) to the commands +that display the next buffer in the window at the specified direction. +This is like 'windmove-default-keybindings' that binds keys to commands +that select the window in the specified direction, but additionally it +displays the buffer from the next command in that window. For example, +'S-M-right C-h i' displays the "*Info*" buffer in the right window, +creating the window if necessary. A special key can be customized to +display the buffer in the same window, for example, 'S-M-0 C-h e' +displays the "*Messages*" buffer in the same window. 'S-M-t C-h C-n' +displays NEWS in a new tab. + +--- +*** Windmove also supports directional window deletion. +The new command 'windmove-delete-default-keybindings' binds default +keys with provided prefix (by default, 'C-x') and modifiers (by default, +'Shift') to the commands that delete the window in the specified +direction. For example, 'C-x S-down' deletes the window below. +With a prefix arg 'C-u', also kills the buffer in that window. +With 'M-0', deletes the selected window and selects the window +that was in the specified direction. + +--- +*** New command 'windmove-swap-states-in-direction' binds default keys +to the commands that swap the states of the selected window with the +window in the specified direction. + +--- +*** Windmove code no longer used is now obsolete. +That includes the user option 'windmove-window-distance-delta' and the +functions 'windmove-coord-add', 'windmove-constrain-to-range', +'windmove-constrain-around-range', 'windmove-frame-edges', +'windmove-constrain-loc-for-movement', 'windmove-wrap-loc-for-movement', +'windmove-reference-loc' and 'windmove-other-window-loc'. + +** Octave mode +The mode is automatically enabled in files that start with the +'function' keyword. + +** project.el + +*** New commands 'project-search' and 'project-query-replace-regexp'. +*** New user option 'project-read-file-name-function'. + +** Etags + ++++ +*** 'next-file' is now an obsolete alias of 'tags-next-file'. + +--- +*** 'tags-loop-revert-buffers' is an obsolete alias of +'fileloop-revert-buffers'. + ++++ +*** The 'tags-loop-continue' function along with the +'tags-loop-operate' and 'tags-loop-scan' variables are now obsolete; +use the new 'fileloop-initialize' and 'fileloop-continue' functions +instead. + ++++ +*** etags is now able to read Zstandard-compressed files. + +** bibtex + +--- +*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'. +In 'bibtex-mode-map', 'forward-paragraph' and 'backward-paragraph' are +remapped to these, respectively. + +** Dired + +--- +*** On systems that support suid/guid files, Dired now fontifies the +permissions of such files with a special face 'dired-set-id'. + ++++ +*** New command 'dired-create-empty-file'. + ++++ +*** New command 'dired-number-of-marked-files'. +It is by default bound to '* N'. + +--- +*** The marking commands now report how many files were marked by the +command itself, not how many files are marked in total. + +--- +*** A new face, 'dired-special', is used to highlight sockets, named +pipes, block devices and character devices. + ++++ +*** The new user option 'dired-create-destination-dirs' controls whether +'dired-do-copy' and 'dired-rename-file' should create non-existent +directories in the destination. + ++++ +*** 'dired-dwim-target' can be customized to prefer either the next window, +or one of the most recently visited windows with a Dired buffer. + ++++ +*** When the new user option 'dired-vc-rename-file' is non-nil, +Dired performs file renaming using underlying version control system. + +--- +*** Zstandard compression is now supported for 'dired-do-compress' and +'dired-do-compress-to'. + +** Find-Dired + +--- +*** New user option 'find-dired-refine-function'. +The default value is 'find-dired-sort-by-filename'. + +--- +*** New sorting options for the user option 'find-ls-option'. + +** Change Logs and VC + +--- +*** New user option 'vc-tor'. +When non-nil, this user option causes the VC commands to communicate +with the repository via Tor's proxy, using the 'torsocks' wrapper +script. The default is nil. + ++++ +*** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'. +This generates ChangeLog entries from the VC fileset diff. + +--- +*** 'vc-dir' now shows a button allowing you to hide the stash list. +Controlled by user option 'vc-git-show-stash'. Default t means show +the entire list as before. An integer value limits the list length +(but still allows you to show the entire list via the button). + ++++ +*** Recording ChangeLog entries doesn't require an actual file. +If a ChangeLog file doesn't exist, and if the new user option +'add-log-dont-create-changelog-file' is non-nil (which is the +default), commands such as 'C-x 4 a' will add log entries to a +suitable named temporary buffer. (An existing ChangeLog file will +still be used if it exists.) Set the user option to nil to get the +previous behavior of always creating a buffer that visits a ChangeLog +file. + +--- +*** New user option 'vc-find-revision-no-save'. +With non-nil, 'vc-find-revision' doesn't write the created buffer to file. + +--- +*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked files. + +--- +*** New user option 'vc-git-grep-template'. +This new user option allows customizing the default arguments passed to +'git-grep' when 'vc-git-grep' is used. + +--- +*** Command 'vc-git-stash' now respects marks in the "*vc-dir*" buffer. +When some files are marked, only those are stashed. +When no files are marked, all modified files are stashed, as before. + +--- +*** 'vc-git-stash' is now bound to 'C' in the stash headers. + +-- +*** Some stash keybindings are now available in the stash button. +'vc-git-stash' and 'vc-git-stash-snapshot' can now be run using 'C' +and 'S' respectively, including when there are no stashes. + +--- +*** The new hook 'vc-retrieve-tag-hook' runs after retrieving a tag. + +--- +*** 'vc-hg' now invokes 'smerge-mode' when visiting files. +Code that attempted to invoke 'smerge-mode' when visiting an Hg file +with conflicts existed in earlier versions of Emacs, but incorrectly +never detected a conflict due to invalid assumptions about cached +values. + ++++ +*** The Hg (Mercurial) back-end now supports 'vc-region-history'. +The 'C-x v h' command now works in buffers that visit files controlled +by Hg. + ++++ +*** The Hg (Mercurial) back-end now prompts for revision to merge when +you invoke 'C-x v m' ('vc-merge'). + +--- +*** The Hg (Mercurial) back-end now uses tags, branches and bookmarks +instead of revision numbers as completion candidates when it prompts +for a revision. + ++++ +*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions +and compares their entire trees. + +*** New user option 'vc-hg-revert-switches'. +It specifies switches to pass to Hg's 'revert' command. + +*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase') +print diffs and logs between the merge base (common ancestor) of two +given revisions. + ++++ +*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode' +buffers will delete the marked files (or if no files are marked, the +file under point). This command does not notify the VC backend, and +is mostly useful for unregistered files. + ++++ +*** New command 'vc-log-search' asks for a pattern, searches it +in the revision log, and displays matched log entries in the +log buffer. For example, 'M-x vc-log-search RET bug#36644 RET' +displays all entries whose log messages match the bug number. +With a prefix argument asks for a command, so for example, +'C-u M-x vc-log-search RET git log -1 f302475 RET' will display +just one log entry found by its revision number. + ++++ +*** It is now possible to display a specific revision given by its ID. +If you invoke 'C-x v L' ('vc-print-root-log') with a numeric argument +of 1, as in 'C-1 C-x v L' or 'C-u 1 C-x v L', it asks for a revision +ID, and shows its log entry together with the diffs introduced by the +revision's commit. (For some less capable VCSes, only the log entry +is shown.) + +--- +*** 'C-x v =' can now mimic Magit's diff format. +Set the new user option 'diff-font-lock-prettify' to t for that, see +below under "Diff mode". + +--- +*** The 'diff' function arguments OLD and NEW may each be a buffer +rather than a file, in non-interactive calls. This change was made in +Emacs 24.1, but wasn't documented until now. + ++++ +*** New command 'diff-buffers' interactively diffs two buffers. + +** Diff mode + ++++ +*** Hunks are now automatically refined by font-lock. +To disable refinement, set the new user option 'diff-refine' to nil. +To get back the old behavior where hunks are refined as you navigate +through a diff, set 'diff-refine' to the symbol 'navigate'. + ++++ +*** 'diff-auto-refine-mode' is deprecated in favor of 'diff-refine'. +It is no longer enabled by default and binding it no longer has any +effect. + ++++ +*** Better syntax highlighting of Diff hunks. +Fragments of source in Diff hunks are now by default highlighted +according to the appropriate major mode. Customize the new user +option 'diff-font-lock-syntax' to nil to disable this. + +--- +*** File headers can be shortened, mimicking Magit's diff format. +To enable it, set the new user option 'diff-font-lock-prettify' to t. +On GUI frames, this option also displays the insertion and deletion +indicators on the left fringe. + ++++ +*** Prefix arg of 'diff-goto-source' means jump to the old revision +of the file under version control if point is on an old changed line, +or to the new revision of the file otherwise. + +** Texinfo + ++++ +*** New function for inserting '@pxref', '@xref', or '@ref' commands. +The function 'texinfo-insert-dwim-@ref', bound to 'C-c C-c r' by +default, inserts one of three types of references based on the text +surrounding point, namely '@pxref' near a parenthesis, '@xref' at the +start of a sentence or at '(point-min)', else '@ref'. + +** Browse-url + +--- +*** The function 'browse-url-emacs' can now visit a URL in selected window. +It now treats the optional 2nd argument to mean that the URL should be +shown in the currently selected window. + +--- +*** A new function, 'browse-url-add-buttons' can be used to add clickable +links to most ordinary special-mode buffers that display text that +have URLs embedded. 'browse-url-button-regexp' controls what's +considered a button. + +--- +*** New user option 'browse-url-secondary-browser-function'. +It can be set to a function that invokes an alternative browser. + +** Comint + ++++ +*** 'send-invisible' is now an obsolete alias for 'comint-send-invisible'. +Also, 'shell-strip-ctrl-m' is declared obsolete. + ++++ +*** 'C-c .' ('comint-insert-previous-argument') no longer interprets '&'. +This feature caused problems when '&&' was present in the previous +command. Since this command emulates 'M-.' in Bash and zsh, neither +of which treats '&' specially, the feature was removed for +compatibility with these shells. + ++++ +*** 'comint-insert-previous-argument' can now count arguments from the end. +By default, invoking 'C-c .' with a numeric argument N would copy the +Nth argument, counting from the first one. But if the new user option +'comint-insert-previous-argument-from-end' is non-nil, it will copy +the Nth argument counting from the last one. Thus 'C-c .' can now +better emulate 'M-.' in both Bash and zsh, since the former counts +from the beginning of the arguments, while the latter counts from the +end. + ++++ +*** 'comint-run' can now accept a list of switches to pass to the program. +'C-u M-x comint-run' will prompt for the switches interactively. + ++++ +*** Abnormal hook 'comint-password-function' has been added. +This hook permits a derived mode to supply a password for the +underlying command interpreter without prompting the user. For +example, in 'sql-mode', the password for connecting to the database may +be stored in the connection wallet and may be passed on the command +line to start the SQL interpreter. This is a potential security flaw +that could expose user's database passwords on the command line +through the use of a process list (Bug#8427). With this hook, it is +possible to not pass the password on the command line and wait for the +program to prompt for the password. When it does so, the password can +be supplied to the SQL interpreter without involving the user just as +if it had been supplied on the command line. + +** SQL + +--- +*** SQL Indent Minor Mode +SQL Mode now supports the ELPA 'sql-indent' package for assisting +sophisticated SQL indenting rules. Note, however, that SQL is not +like other programming languages like C, Java, or Python where code is +sparse and rules for formatting are fairly well established. Instead +SQL is more like COBOL (from which it came) and code tends to be very +dense and line ending decisions driven by syntax and line length +considerations to make readable code. Experienced SQL developers may +prefer to rely upon existing Emacs facilities for formatting code but +the 'sql-indent' package provides facilities to aid more casual SQL +developers layout queries and complex expressions. + +--- +**** 'sql-use-indent-support' (default t) enables SQL indention support. +The 'sql-indent' package from ELPA must be installed to get the +indentation support in 'sql-mode' and 'sql-interactive-mode'. + +--- +**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed. +Both hook variables have had 'sql-indent-enable' added to their +default values. If you have existing customizations to these +variables, you should make sure that the new default entry is +included. + +--- +*** Connection Wallet +Database passwords can now by stored in NETRC or JSON data files that +may optionally be encrypted. When establishing an interactive session +with the database via 'sql-connect' or a product specific function, +like 'sql-mysql' or 'sql-postgres', the password wallet will be +searched for the password. The 'sql-product', 'sql-server', +'sql-database', and the 'sql-username' will be used to identify the +appropriate authorization. This eliminates the discouraged practice of +embedding database passwords in your Emacs initialization. + +See the 'auth-source' module for complete documentation on the file +formats. By default, the wallet file is expected to be in the +'user-emacs-directory', named "sql-wallet" or ".sql-wallet", with +".json" (JSON) or no (NETRC) suffix. Both file formats can optionally +be encrypted with GPG by adding an additional ".gpg" suffix. + +** Term + +--- +*** 'term-read-noecho' is now obsolete, use 'read-passwd' instead. + ++++ +*** 'serial-term' now takes an optional parameter to leave the +emulator in line mode. + +** Flymake + ++++ +*** The variable 'flymake-diagnostic-types-alist' is obsolete. +You should instead set properties on known diagnostic symbols, like +':error' and ':warning', as demonstrated in the Flymake manual. + ++++ +*** New user option 'flymake-start-on-save-buffer'. +Control whether Flymake starts checking the buffer on save. + +--- +*** Flymake and backend functions may exchange hints about buffer changes. +This enables more efficient backends. See the docstring of +'flymake-diagnostic-functions' or the Flymake manual for details. + ++++ +*** 'flymake-start-syntax-check-on-newline' is now obsolete, +use 'post-self-insert-hook' to check on newline. + +** Ruby + +--- +*** The Rubocop Flymake diagnostic function will only run Lint cops if +it can't find the config file. + +--- +*** Rubocop is called with 'bundle exec' if Gemfile mentions it. + +--- +*** New command 'ruby-find-library-file' bound to 'C-c C-f'. + +** Package + +--- +*** Warn if "footer line" is missing, but still install package. +package.el used to refuse to install a package without the so-called +"footer line", which appears at the very end of the file: + +;;; FILENAME ends here + +package.el will now install packages without this line, but it will +issue a warning. To avoid this warning, packages should keep the +"footer line". + +Note that versions of Emacs older than 27.1 will not only refuse to +install packages without such a line -- they will be unable to parse +package data. It is therefore recommended to keep this line. + ++++ +*** Change of 'package-check-signature' for packages with multiple sigs. +In previous Emacsen, t checked that all signatures are valid. +Now t only checks that at least one signature is valid and the new 'all' +value needs to be used if you want to enforce that all signatures +are valid. This only affects packages with multiple signatures. + ++++ +*** The meaning of 'allow-unsigned' in 'package-check-signature' has +changed slightly: If a usable OpenPGP configuration can't be found +(for instance, if gpg isn't installed), it now has the same meaning as +nil. + +--- +*** New function 'package-get-version' lets packages query their own version. +Example use in auctex.el: '(defconst auctex-version (package-get-version))' + +--- +*** New 'package-quickstart' feature. +When 'package-quickstart' is non-nil, package.el precomputes a big +autoloads file so that activation of packages can be done much faster, +which can speed up your startup significantly. +It also causes user options like 'package-user-dir' and +'package-load-list' to be consulted when 'package-quickstart-refresh' +is run rather than at startup so you don't need to set them in your +early init file. + +--- +*** New function 'package-activate-all'. + ++++ +*** New functions for filtering packages list. +A new function has been added which allows users to filter the +packages list by name: 'package-menu-filter-by-name'. By default, it +is bound to '/ n'. Additionally, the function +'package-menu-filter-by-keyword' has been renamed from +'package-menu-filter'. Its keybinding has also been changed to '/ k' +(from 'f'). To clear any of the two filters, the user can now call +the 'package-menu-clear-filter' function, bound to '/ /' by default. + +--- +*** Imenu support has been added to 'package-menu-mode'. + +--- +*** The package list can now be sorted by version or description. + ++++ +*** In Package Menu, 'g' now updates package data from archives. +Previously, 'g' invoked 'tabulated-list-revert' which did not update +the cached archive data. It is now bound to 'revert-buffer', which +will update the data. + +'package-menu-refresh' is an obsolete alias for 'revert-buffer'. + +** Info + ++++ +*** Clicking on the left/right arrow icon in the Info tool-bar while +holding down the Ctrl key pops up a menu of previously visited Info nodes +where you can select a node to go back (like in browsers). + +--- +*** Info can now follow 'file://' protocol URLs. +The 'file://' URLs in Info documents can now be followed by passing +them to the 'browse-url' function, like the other protocols: 'ftp', +'http', and 'https'. This allows having references to local HTML +files, for example. + +--- +** Display of man pages now limits the width for formatting pages. +The new user option 'Man-width-max' (80 by default) limits the number +of columns passed to the 'man' program for formatting man pages. This +is to enhance readability when man pages are displayed in very wide +windows (which are customary with today's large displays). + +** Xref + ++++ +*** New command 'xref-find-definitions-at-mouse'. +This command finds definitions of the identifier at the place of a +mouse click event, and is intended to be bound to a mouse event. + ++++ +*** Changing 'xref-marker-ring-length' works after xref.el is loaded. +Previously, setting 'xref-marker-ring-length' would only take effect +if set before xref.el was loaded. + +--- +*** 'xref-find-definitions' now sets the mark at the buffer position +where it was invoked. + +--- +*** New xref faces 'xref-file-header', 'xref-line-number', 'xref-match'. + +--- +*** New user option 'xref-show-definitions-function'. +It encapsulates the logic pertinent to showing the result of +'xref-find-definitions'. The user can change it to customize its +behavior and the display of results. + +--- +*** Search results show the buffer even for one hit. +The search-type Xref commands (e.g. 'xref-find-references' or +'project-find-regexp') now show the results buffer even when there is +only one hit. This can be altered by changing 'xref-show-xrefs-function'. + ++++ +*** Xref buffers support refreshing the search results. +A new command 'xref-revert-buffer' is bound to 'g'. + +--- +*** Imenu support has been added to 'xref--xref-buffer-mode'. + +*** New generic method 'xref-backend-identifier-completion-ignore-case'. +Using it, the etags backend now honors 'tags-case-fold-search' during +identifier completion. + +** Checkdoc + +--- +*** Checkdoc can now optionally spell-check doc strings. +Invoking 'checkdoc-buffer' with a non-nil TAKE-NOTES argument +(interactively, with a prefix arg) will now spell-check the doc +strings and report all the spelling mistakes. + +** Icomplete + ++++ +*** New minor mode Fido mode. +This mode is based on Icomplete, and its name stands for "Fake Ido". +The point of this mode is to be an 'ido-mode' workalike, but provide +most of the functionality present in Icomplete that is not in +'ido-mode', while being much more compatible with all of Emacs's +completion facilities. + +** Ecomplete + +--- +*** The Ecomplete sorting has changed to a decay-based algorithm. +This can be controlled by the new 'ecomplete-sort-predicate' user option. + +--- +*** The 'ecomplete-database-file' file is now placed in +"~/.emacs.d/ecompleterc" by default. Of course it will still find it +if you have it in "~/.ecompleterc". + +** Gnus + +--- +*** 'mm-uu-diff-groups-regexp' now defaults to matching all groups, +which means that "git am" diffs are recognized everywhere. + ++++ +*** Two new Gnus summary mode navigation commands have been added, +bound to the '[' and ']' keys: 'gnus-summary-prev-unseen-article' and +'gnus-summary-next-unseen-article'. These take you (respectively) to +the previous unseen or next unseen article. (These are the ones that +are marked with "." in the summary mode lines.) + ++++ +*** The Gnus user variable 'nnimap-expunge' supports three new values: +'never' for never expunging messages, 'immediately' for immediately +expunging deleted messages, and 'on-exit' to expunge deleted articles +when exiting the group's summary buffer. Setting 'nnimap-expunge' to +nil or t is still supported but not recommended, since it may +result in Gnus expunging all messages that have been flagged as +deleted by any IMAP client (rather than just those that have been +deleted by Gnus). + ++++ +*** New user option 'gnus-use-atomic-windows' makes Gnus window layouts atomic. +See the "(elisp) Atomic Windows" node of the Elisp manual for details. + ++++ +*** There's a new value for 'gnus-article-date-headers', +'combined-local-lapsed', which will show both the time (in the local +timezone) and the lapsed time. + +--- +*** Gnus now maps imaps to 993 only on old MS-Windows versions. +The nnimap backend used to do this unconditionally to work around +problems on old versions of MS-Windows. This is now done only for +Windows XP and older. + ++++ +*** The nnimap backend now has support for IMAP namespaces. +This feature can be enabled by setting the new 'nnimap-use-namespaces' +server variable to non-nil. + ++++ +*** A prefix argument to 'gnus-summary-limit-to-score' will limit in reverse. +Limit to articles with score "at or below" the SCORE argument rather +than "at or above". + +--- +*** The function 'gnus-score-find-favorite-words' has been renamed +from 'gnus-score-find-favourite-words'. + +--- +*** Gmane has been removed as an nnir backend, since Gmane no longer +has a search engine. + ++++ +*** Splitting mail on common mailing list headers has been added. +See the concept index in the Gnus manual for the 'match-list' entry. + ++++ +*** nil is no longer an allowed value for 'mm-text-html-renderer'. + ++++ +*** The default value of 'mm-inline-large-images' has changed from nil +to 'resize', which means that large images will be resized instead of +displayed with an external program by default. + ++++ +*** A new Gnus summary mode command, 'S A' ('gnus-summary-attach-article') +can be used to attach the current article(s) to a pre-existing Message +buffer, or create a new Message buffer with the article(s) attached. + ++++ +*** A new Gnus summary mode command, 'w' ('gnus-summary-browse-url') +scans the article buffer for URLs, and offers them to the user to open +with 'browse-url'. + +--- +*** New user option 'nnir-notmuch-filter-group-names-function'. +This option controls whether and how to use Gnus search groups as +'path:' search terms to 'notmuch'. + +--- +*** The buttons in the Gnus article buffer were formerly widgets +(i.e., buttons from widget.el). This has now changed, and they are +now buttons (from button.el), and commands like 'TAB' now search for +buttons instead of widgets. There should be no user-visible changes, +but out-of-tree code that relied on widgets being present might now +fail. + +** erc + +--- +*** New hook 'erc-insert-done-hook'. +This hook is called after strings have been inserted into the buffer, +and is free to alter point and window configurations, as it's not +called from inside a 'save-excursion', as opposed to 'erc-insert-post-hook'. + +--- +*** 'erc-button-google-url' has been renamed to 'erc-button-search-url' +and its value has been changed to Duck Duck Go. + +--- +*** 'erc-send-pre-hook' and 'erc-send-this' have been obsoleted. +The user option to use instead to alter text to be sent is now +'erc-pre-send-functions'. + +--- +*** Improve matching/highlighting of nicknames. +Open and close parenthesis and apostrophe are not considered valid +nick characters anymore, matching the given grammar in RFC 2812 +section 2.3.1. This enables correct matching and highlighting of +nicks when they are surrounded by parentheses, like "(nick)", and when +adjacent to an apostrophe, like "nick's". + +--- +*** Set 'erc-button-url-regexp' to 'browse-url-button-regexp' +which better handles surrounding pair of parentheses. + +** EUDC + +--- +*** XEmacs support has been removed. + +** eww/shr + ++++ +*** The new user option 'shr-cookie-policy' can be used to control +when to use cookies when fetching embedded images. The default is to +use them when the images are from the same domain as the main HTML +document. + ++++ +*** The 'eww' command can now create a new EWW buffer. +Invoking the command with a prefix argument will cause it to create a +new EWW buffer for the URL instead of reusing the default one. + ++++ +*** Clicking with the Ctrl key or 'C-u RET' on a link opens a new tab +when tab-bar-mode is enabled. + ++++ +*** The 'd' ('eww-download') command now falls back to current page's URL. +If this command is invoked with no URL at point, it now downloads the +current page instead of signaling an error. + +*** When opening external links in eww/shr (typically with the +'C-u RET' keystroke on a link), the link will be flashed with the new +'shr-selected-link' face to give the user feedback that the command +has been executed. + ++++ +*** New user option 'shr-discard-aria-hidden'. +If set, shr will not render tags with attribute 'aria-hidden="true"'. +This attribute is meant to tell screen readers to ignore a tag. + ++++ +*** 'shr-external-browser' has been made into an obsolete alias +of 'browse-url-secondary-browser-function'. + +--- +*** 'shr-tag-ol' now respects the ordered list 'start' attribute. + +--- +*** The following tags are now handled: '<code>', '<abbr>', and '<acronym>'. + +** Htmlfontify + ++++ +*** The functions 'hfy-color', 'hfy-color-vals' and +'hfy-fallback-color-values' and the variables 'hfy-fallback-color-map' +and 'hfy-rgb-txt-color-map' have been renamed from names that used +'colour' instead of 'color'. + ++++ +** Enriched mode supports the 'charset' text property. +You can add or modify the 'charset' text properties of text using the +'Edit->Text Properties->Special Properties' menu, or by invoking the +'facemenu-set-charset' command. Documents in Enriched mode will be +saved with the charset properties, and those properties will be +restored when the file is visited. + +** Smtpmail + +--- +*** Authentication mechanisms can be added via external packages, by +defining new 'cl-defmethod' of 'smtpmail-try-auth-method'. + ++++ +*** To always force smtpmail to send credentials over on the first +attempt when communicating with the SMTP server(s), the +'smtpmail-servers-requiring-authorization' user option can be used. + ++++ +*** smtpmail will now try resending mail when getting a transient "4xx" +error message from the SMTP server. The new 'smtpmail-retries' +user option says how many times to retry. + +** Footnote mode + +--- +*** Support Hebrew-style footnotes. + +--- +*** Footnote text lines are now aligned. +Can be controlled via the new user option 'footnote-align-to-fn-text'. + +** CSS mode + +--- +*** A new command 'css-cycle-color-format' for cycling between color +formats (e.g. "black" => "#000000" => "rgb(0, 0, 0)") has been added, +bound to 'C-c C-f'. + +--- +*** CSS mode, SCSS mode, and Less CSS mode now have support for Imenu. + +** SGML mode + +--- +*** 'sgml-quote' now handles double quotes and apostrophes +when escaping text and in addition all numeric entities when +unescaping text. + +** Python mode + +--- +*** Python mode supports three different font lock decoration levels. +The maximum level is used by default; customize +'font-lock-maximum-decoration' to tone down the decoration. + +--- +*** New user option 'python-pdbtrack-kill-buffers'. +If non-nil, the default, buffers opened during pdbtracking session are +killed when pdbtracking session is finished. + +--- +*** New function 'python-shell-send-statement. +It sends the statement delimited by 'python-nav-beginning-of-statement' +and 'python-nav-end-of-statement' to the inferior Python process. + +** Help + +--- +*** Descriptions of variables and functions give an estimated first release +where the variable or function appeared in Emacs. + +--- +*** Output format of 'C-h l' ('view-lossage') has changed. +For convenience, 'view-lossage' now displays the last keystrokes +and commands in the same format as the edit buffer of +'edit-last-kbd-macro'. This makes it possible to copy the lines from +the buffer generated by 'view-lossage' to the "*Edit Macro*" buffer +created by 'edit-last-kbd-macro', and to save the macro by 'C-c C-c'. + +--- +*** The list of help commands produced by 'C-h C-h' ('help-for-help') +can now be searched via 'C-s'. + +** Ibuffer + +--- +*** New filter 'ibuffer-filter-by-process'; bound to '/ E'. + +--- +*** All mode filters can now accept a list of symbols. +This means you can now easily filter several major modes, as well +as a single mode. + +** Search and Replace + ++++ +*** Isearch supports a prefix argument for 'C-s' ('isearch-repeat-forward') +and 'C-r' ('isearch-repeat-backward'). With a prefix argument, these +commands repeat the search for the specified occurrence of the search string. +A negative argument repeats the search in the opposite direction. +This makes possible also to use a prefix argument for 'M-s .' +('isearch-forward-symbol-at-point') to find the next Nth symbol. +Also a prefix argument is supported for 'isearch-yank-until-char', +'isearch-yank-word-or-char', 'isearch-yank-symbol-or-char'. + ++++ +*** To go to the first/last occurrence of the current search string +is possible now with new commands 'isearch-beginning-of-buffer' and +'isearch-end-of-buffer' bound to 'M-s M-<' and 'M-s M->' in Isearch. +With a numeric argument, they go to the Nth absolute occurrence +counting from the beginning/end of the buffer. This complements +'C-s'/'C-r' that searches for the next Nth relative occurrence +with a numeric argument. + ++++ +*** 'isearch-lazy-count' shows the current match number and total number +of matches in the Isearch prompt. User options +'lazy-count-prefix-format' and 'lazy-count-suffix-format' define the +format of the current and the total number of matches in the prompt's +prefix and suffix, respectively. + +--- +*** 'lazy-highlight-buffer' highlights matches in the full buffer. +It is useful in combination with 'lazy-highlight-cleanup' customized to nil +to leave matches highlighted in the whole buffer after exiting isearch. +Also when 'lazy-highlight-buffer' prepares highlighting in the buffer, +navigation through the matches without flickering is more smooth. +'lazy-highlight-buffer-max-at-a-time' controls the number of matches to +highlight in one iteration while processing the full buffer. + ++++ +*** New isearch bindings. +'C-M-z' invokes new function 'isearch-yank-until-char', which yanks +everything from point up to but not including the specified +character into the search string. This is especially useful for +keyboard macros. + +'C-M-w' in isearch changed from 'isearch-del-char' to the new function +'isearch-yank-symbol-or-char'. 'isearch-del-char' is now bound to +'C-M-d'. + ++++ +'M-s h l' invokes 'highlight-lines-matching-regexp' using the search +string to highlight lines matching the search string. This is similar +to the existing binding 'M-s h r' ('highlight-regexp') that highlights +JUST the search string. + ++++ +*** New user option 'isearch-yank-on-move' provides options t and 'shift' +to extend the search string by yanking text that ends at the new +position after moving point in the current buffer. 'shift' extends +the search string by motion commands while holding down the shift key. + ++++ +*** 'isearch-allow-scroll' provides a new option 'unlimited' to allow +scrolling any distance off screen. + +--- +*** Isearch now remembers the regexp-based search mode for words/symbols +and case-sensitivity together with search strings in the search ring. + +--- +*** Isearch now has its own tool-bar and menu-bar menu. + ++++ +*** 'flush-lines' prints and returns the number of deleted matching lines. + +--- +*** 'char-fold-to-regexp' now matches more variants of a base character. +The table used to check for equivalence of characters is now built +using the complete chain of unicode decompositions of a character, +rather than stopping after one level, such that searching for +e.g. "GREEK SMALL LETTER IOTA" will now also find "GREEK SMALL LETTER +IOTA WITH OXIA". + ++++ +*** New char-folding options: 'char-fold-include' lets you add ad hoc +foldings, 'char-fold-exclude' to remove foldings from default decomposition, +and 'char-fold-symmetric' to search for any of an equivalence class of +characters. For example, with a nil value of 'char-fold-symmetric' +you can search for "e" to find "é", but not vice versa. With a non-nil +value you can search for either, for example, you can search for "é" +to find "e". + +** Debugger + ++++ +*** The Lisp Debugger is now based on 'backtrace-mode'. +Backtrace mode adds fontification and commands for changing the +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. + +** Edebug + ++++ +*** 'edebug-eval-last-sexp' and 'edebug-eval-print-last-sexp' interactively +now take a zero prefix analogously to the non-Edebug counterparts. + ++++ +*** New faces 'edebug-enabled-breakpoint' and 'edebug-disabled-breakpoint'. +When setting breakpoints in Edebug, an overlay with these faces are +placed over the point in question, depending on whether they are +enabled or not. + ++++ +*** New command 'edebug-toggle-disable-breakpoint'. +This command allows you to disable a breakpoint temporarily. This is +mainly useful with breakpoints that are conditional and would take +some time to recreate. + ++++ +*** New command 'edebug-unset-breakpoints'. +To clear all breakpoints in the current form, the 'U' command in +'edebug-mode', or 'M-x edebug-unset-breakpoints' can be used. + +--- +*** Re-instrumenting a function with Edebug will now try to preserve +previously-set breakpoints. However, if the code has changed +substantially, this may not be possible. + ++++ +*** New command 'edebug-remove-instrumentation'. +This command removes Edebug instrumentation from all functions that +have been instrumented. + ++++ +*** The runtime behavior of Edebug's instrumentation can be changed +using the new variables 'edebug-behavior-alist', +'edebug-after-instrumentation-function' and +'edebug-new-definition-function'. Edebug's behavior can be changed +globally or for individual definitions. + ++++ +*** Edebug's backtrace buffer now uses 'backtrace-mode'. +Backtrace mode adds fontification, links and commands for changing the +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. + +The binding of 'd' in Edebug's keymap is now 'edebug-pop-to-backtrace' +which replaces 'edebug-backtrace'. Consequently Edebug's backtrace +windows now behave like those of the Lisp Debugger and of ERT, in that +when they appear they will be the selected window. + +The new 'backtrace-goto-source' command, bound to 's', works in +Edebug's backtraces on backtrace frames whose source code has +been instrumented by Edebug. + +** Enhanced xterm support + +--- +*** New user option 'xterm-set-window-title' controls whether Emacs sets +the XTerm window title. This feature is experimental and is disabled +by default. + +** Grep + ++++ +*** 'rgrep', 'lgrep' and 'zrgrep' now hide part of the command line +that contains a list of ignored directories and files. +Clicking on the button with ellipsis unhides it. +The abbreviation can be disabled by the new user option +'grep-find-abbreviate'. The new command +'grep-find-toggle-abbreviation' toggles it interactively. + +--- +*** 'grep-find-use-xargs' is now customizable with sorting options. + +** ERT + ++++ +*** New variable 'ert-quiet' allows making ERT output in batch mode +less verbose by removing non-essential information. + ++++ +*** ERT's backtrace buffer now uses 'backtrace-mode'. +Backtrace mode adds fontification and commands for changing the +appearance of backtrace frames. See the node "(elisp) Backtraces" in +the Elisp manual for documentation of the new mode and its commands. + +** Gamegrid + +--- +*** Gamegrid now determines its default glyph size based on display +dimensions, instead of always using 16 pixels. As a result, Tetris, +Snake and Pong are better playable on HiDPI displays. + +--- +*** 'gamegrid-add-score' can now sort scores from lower to higher. +This is useful for games where lower scores are better, like time-based games. + +** Filecache + +--- +*** Completing file names in the minibuffer via 'C-TAB' now uses the +styles as configured by the user option 'completion-styles'. + +** New macros 'thunk-let' and 'thunk-let*'. +These macros are analogue to 'let' and 'let*', but create bindings that +are evaluated lazily. + +** next-error + ++++ +*** New user option 'next-error-find-buffer-function'. +The value should be a function that determines how to find the +next buffer to be used by 'next-error' and 'previous-error'. The +default is to use the last buffer that navigated to the current +error. + ++++ +*** New command 'next-error-select-buffer'. +It can be used to set any buffer as the next one to be used by +'next-error' and 'previous-error'. + +** nxml-mode + +--- +*** The default value of 'nxml-sexp-element-flag' is now t. +This means that pressing 'C-M-SPACE' now selects the entire tree by +default, and not just the opening element. + +** Eshell + +--- +*** TAB completion uses the standard 'completion-at-point' rather than +'pcomplete'. Its UI is slightly different but can be customized to +behave similarly, e.g. Pcomplete's default cycling can be obtained +with '(setq completion-cycle-threshold 5)'. + +--- +*** Eshell no longer re-initializes its keymap every call. +This allows users to use (define-key eshell-mode-map ...) as usual. +Some modules have their own minor mode now to account for these +changes. + ++++ +*** Expansion of history event designators is disabled by default. +To restore the old behavior, use + + (add-hook 'eshell-expand-input-functions + #'eshell-expand-history-references) + +--- +*** The function 'eshell-uniquify-list' has been renamed from +'eshell-uniqify-list'. + +--- +*** The function 'eshell/kill' is now able to handle signal switches. +Previously 'eshell/kill' would fail if provided a kill signal to send +to the process. It now accepts signals specified either by name or by +its number. + +--- +*** Emacs now follows symlinks in history-related files. +The files specified by 'eshell-history-file-name' and +'eshell-last-dir-ring-file-name' can include symlinks; these are now +followed when Emacs writes the relevant history variables to the disk. + +** Shell + +--- +*** Program name completion inside remote shells works now as expected. + ++++ +*** The user option 'shell-file-name' can be set now as connection-local +variable for remote shells. It still defaults to "/bin/sh". + +** Single shell commands + ++++ +*** 'shell-command-dont-erase-buffer' accepts the value 'erase' to +force to erase the output buffer before execution of the command. + +*** The new functions 'shell-command-save-pos-or-erase' and +'shell-command-set-point-after-cmd' control how point is handled +between two consecutive shell commands in the same buffer. + ++++ +*** 'async-shell-command-width' defines the number of display columns +available for output of asynchronous shell commands. + ++++ +*** Prompt for shell commands can now show the current directory. +Customize the new user option 'shell-command-prompt-show-cwd' to enable it. + +** Pcomplete + +--- +*** The 'pcomplete' command is now obsolete. +The Pcomplete functionality can be obtained via 'completion-at-point' +instead, by adding 'pcomplete-completions-at-point' to +'completion-at-point-functions'. + +--- +*** The function 'pcomplete-uniquify-list' has been renamed from +'pcomplete-uniqify-list'. + +--- +*** 'pcomplete/make' now completes on targets in included files, recursively. +To recover the previous behavior, set new user option +'pcmpl-gnu-makefile-includes' to nil. + +** Auth-source + +--- +*** The Secret Service backend supports the ':create' key now. + +--- +*** ".authinfo" and ".netrc" files now use a new mode: 'authinfo-mode'. +This is just like 'fundamental-mode', except that it hides passwords +under a "****" display property. When the cursor moves to this text, +the real password is revealed (via 'reveal-mode'). The new +'authinfo-hidden' user option can be used to control what to hide. + +** Tramp + ++++ +*** New connection method "nextcloud", which allows accessing OwnCloud +or NextCloud hosted files and directories. + ++++ +*** New connection method "rclone", which allows accessing system +storages via the 'rclone' program. This feature is experimental. + ++++ +*** New connection method "sudoedit", which allows editing local files +with different user credentials. Contrary to the "sudo" method, no +session is run permanently in the background. This is for security +reasons. + ++++ +*** Connection methods "obex" and "synce" have been removed, because they +are obsoleted in GVFS. + ++++ +*** Validated passwords are saved by auth-source backends which support this. + ++++ +*** During user and host name completion in the minibuffer, results +from auth-source search are taken into account. This can be disabled +by setting the user option 'tramp-completion-use-auth-sources' to nil. + ++++ +*** The user option 'tramp-ignored-file-name-regexp' allows disabling +Tramp for some look-alike remote file names. + ++++ +*** For some connection methods, like "su" or "sudo", the host name in +multi-hop file names must match the previous hop. Default host names +are adjusted to the host name from the previous hop. + ++++ +*** A timeout has been added for the connection methods "sudo" and "doas". +The underlying session is disabled when the timeout expires. This is +for security reasons. + ++++ +*** For some connection methods, like "sshx" or "plink", it is +possible to configure the remote login shell. This avoids problems +with remote hosts, where "/bin/sh" is a link to a shell which +cooperates badly with Tramp. + ++++ +*** New commands 'tramp-rename-files' and 'tramp-rename-these-files'. +They allow saving remote files somewhere else when the corresponding +host is not reachable anymore. + +** Rcirc + +--- +*** New user option 'rcirc-url-max-length'. +Setting this option to an integer causes URLs displayed in Rcirc +buffers to be truncated to that many characters. + +--- +*** The default '/quit' and '/part' reasons are now configurable. +Two new user options are provided for this: +'rcirc-default-part-reason' and 'rcirc-default-quit-reason'. + +** Register + +--- +*** The return value of method 'register-val-describe' includes the +names of buffers shown by the windows of a window configuration. + +** Message + +--- +*** Completion of email addresses can use the standard completion UI. +This is controlled by 'message-expand-name-standard-ui'. +With the standard UI the different sources (ecomplete, bbdb, and eudc) +are matched together and try to obey 'completion-styles'. +It should work for other completion front ends like Company. + +--- +*** 'message-mode' now supports highlighting citations of different depths. +This can be customized via the new user option +'message-cite-level-function' and the new 'message-cited-text-*' faces. + ++++ +*** Messages can now be systematically encrypted +when the PGP keyring contains a public key for every recipient. To +achieve this, add 'message-sign-encrypt-if-all-keys-available' to +'message-send-hook'. + +--- +*** When replying a message that have addresses on the form +'"foo@bar.com" <foo@bar.com>', Message will elide the repeated "name" +from the address field in the response. + +--- +*** The default of 'message-forward-as-mime' has changed from t to nil +as it has been reported that many recipients can't read forwards that +are formatted as MIME digests. + ++++ +*** 'message-forward-included-headers' has changed its default to +exclude most headers when forwarding. + +*** 'mml-secure-openpgp-sign-with-sender' sets also "gpg --sender". +When 'mml-secure-openpgp-sign-with-sender' is non-nil message sender's +email address (in addition to its old behavior) will also be used to +set gpg's "--sender email@domain" option. + +The option is useful for two reasons when verifying the signature: + + 1. GnuPG's TOFU statistics are updated for the specific user id + (email) only. See gpg(1) man page about "--sender". + + 2. GnuPG's "--auto-key-retrieve" functionality can use WKD (web key + directory) method for finding the signer's key. You need GnuPG + 2.2.17 to fully benefit from this feature. See gpg(1) man page for + "--auto-key-retrieve". + +--- +** EasyPG + +--- +*** 'epa-pinentry-mode' is renamed to 'epg-pinentry-mode'. +It now applies to epg functions as well as epa functions. + +--- +*** The alias functions 'epa--encode-coding-string', +'epa--decode-coding-string', and 'epa--select-safe-coding-system' have +been removed. Use 'encode-coding-string', 'decode-coding-string', and +'select-safe-coding-system' instead. + +--- +*** 'epg-context' structure supports now 'sender' slot. +The value of the new 'sender' slot (if a string) is used to set gpg's +"--sender" option. This feature is used by +'mml-secure-openpgp-sign-with-sender'. See gpg(1) manual page about +"--sender" for more information. + +--- +** Rmail + ++++ +*** New user option 'rmail-output-reset-deleted-flag'. +If this option is non-nil, messages appended to an output file by the +'rmail-output' command have their Deleted flag reset. + +--- +*** The command 'rmail-summary-by-senders' with an empty argument +selects the messages to summarize with a regexp that matches the +sender of the current message. + +** Threads + ++++ +*** New variable 'main-thread' holds Emacs's main thread. +This is handy in Lisp programs that run on a non-main thread and want +to signal the main thread, e.g., when they encounter an error. + ++++ +*** 'thread-join' now returns the result of the finished thread. + ++++ +*** 'thread-signal' does not propagate errors to the main thread. +Instead, error messages are just printed in the main thread. + +--- +*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. + ++++ +*** New command 'list-threads' shows Lisp threads. +See the current list of live threads in a tabulated-list buffer which +automatically updates. In the buffer, you can use 's q' or 's e' to +signal a thread with quit or error respectively, or get a snapshot +backtrace with 'b'. + +** thingatpt.el + +--- +*** 'thing-at-point' supports a new "thing" called 'uuid'. +A symbol 'uuid' can be passed to 'thing-at-point' and it returns the +UUID at point. + +--- +*** 'number-at-point' will now recognize hex numbers like 0xAb09 and #xAb09 +and return them as numbers. + +--- +*** 'word-at-point' and 'sentence-at-point' accept NO-PROPERTIES. +Just like 'thing-at-point' itself. + +** Interactive automatic highlighting + ++++ +*** 'highlight-regexp' can now highlight subexpressions. +The new command accepts a prefix numeric argument to choose the +subexpression. + +** Mouse display of minor mode menu + +--- +*** 'minor-mode-menu-from-indicator' now displays full minor mode name. +When there is no menu for a mode, display the mode name after the +indicator instead of just the indicator (which is sometimes cryptic). + +** rx + +--- +*** rx now handles raw bytes in character alternatives correctly, +when given in a string. Previously, '(any "\x80-\xff")' would match +characters U+0080...U+00FF. Now the expression matches raw bytes in +the 128...255 range, as expected. + +--- +*** The rx 'or' and 'seq' forms no longer require any arguments. +'(or)' produces a regexp that never matches anything, while '(seq)' +matches the empty string, each being an identity for the operation. +This also works for their aliases: '|' for 'or'; ':', 'and' and +'sequence' for 'seq'. +The symbol 'unmatchable' can be used as an alternative to '(or)'. + +--- +*** 'regexp' and new 'literal' accept arbitrary lisp as arguments. +In this case, 'rx' will generate code which produces a regexp string +at run time, instead of a constant string. + +--- +*** New rx extension mechanism: 'rx-define', 'rx-let', 'rx-let-eval'. +These macros add new forms to the rx notation. + ++++ +*** 'anychar' is now an alias for 'anything'. +Both match any single character; 'anychar' is more descriptive. + ++++ +*** New 'intersection' form for character sets. +With 'or' and 'not', it can be used to compose character-matching +expressions from simpler parts. + ++++ +*** 'not' argument can now be a character or single-char string. + +** Frames + ++++ +*** New command 'make-frame-on-monitor' makes a frame on the specified monitor. + ++++ +*** New value of 'minibuffer' frame parameter 'child-frame'. +This allows creating and immediately parenting a minibuffer-only child +frame when making a frame. + +--- +*** New predicates 'display-blink-cursor-p' and 'display-symbol-keys-p'. +These predicates are to be preferred over 'display-graphic-p' when +testing for blinking cursor capability and the capability to have +symbols (e.g., '[return]', '[tab]', '[backspace]') as keys respectively. + +** Tabulated List mode + ++++ +*** New user options for tabulated list sort indicators. +You can now customize which sorting indicator character to display +near the current column in Tabulated Lists (see user options +'tabulated-list-gui-sort-indicator-asc', +'tabulated-list-gui-sort-indicator-desc', +'tabulated-list-tty-sort-indicator-asc', and +'tabulated-list-tty-sort-indicator-desc'). + ++++ +*** Two new commands and keystrokes have been added to the tabulated +list mode: 'w' (which widens the current column) and 'c' which makes +the current column contract. + ++++ +*** New function 'tabulated-list-clear-all-tags'. +This function clears all tags from the padding area in the current +buffer. Tags are typically added by calling 'tabulated-list-put-tag'. + +** Text mode + ++++ +*** 'text-mode-variant' is now obsolete, use 'derived-mode-p' instead. + +** CUA mode + +--- +*** New user option 'cua-rectangle-terminal-modifier-key'. +This user option allows for the customization of the modifier key used +in a terminal frame. + +** JS mode + +--- +*** JSX syntax is now automatically detected and enabled. +If a file imports Facebook's 'React' library, or if the file uses the +extension ".jsx", then various features supporting XML-like syntax +will be supported in 'js-mode' and derivative modes. ('js-jsx-mode' +no longer needs to be enabled.) + +--- +*** New user option 'js-jsx-detect-syntax' disables automatic detection. +This is turned on by default. + +--- +*** New user option 'js-jsx-syntax' enables JSX syntax unconditionally. +This is off by default. + +--- +*** New variable 'js-jsx-regexps' controls JSX detection. + +--- +*** JSX syntax is now highlighted like SGML. + +--- +*** JSX code is properly indented in many more scenarios. +Previously, JSX indentation usually only worked when an element was +wrapped in parenthesis (e.g. in a 'return' statement or a function +call). It would also fail in many intricate cases. Now, indentation +should work anywhere without parenthesis; many more intricacies are +supported; and, indentation conventions align more closely with those +of the React developer community (see 'js-jsx-align->-with-<'), +otherwise still adhering to SGML conventions. + +--- +*** New user option 'js-jsx-align->-with-<' controls '>' indents. +Commonly in JSX code, a '>' on its own line is indented at the same +level as its opening '<'. This is the new default for JSX. This +behavior is slightly different than that used by SGML in Emacs, where +'>' is indented at the same level as attributes, which was also the +old default for JSX. + +This is turned on by default. To get back the old default indentation +behavior of aligning '>' with attributes, set 'js-jsx-align->-with-<' +to nil. + +--- +*** Indentation uses 'js-indent-level' instead of 'sgml-basic-offset'. +Since JSX is a syntax extension of JavaScript, it makes the most sense +for JSX expressions to be indented the same number of spaces as other +JS expressions. This is a breaking change, but it probably aligns +with how you'd expect this indentation to behave. If you want JSX to +be indented like JS, you won't need to change your config. + +The old behavior can be emulated by controlling JSX indentation +independently of JS, by setting 'js-jsx-indent-level'. + +--- +*** New user option 'js-jsx-indent-level' for different JSX indentation. +If you wish to indent JSX by a different number of spaces than JS, set +this user option to the desired number. + +--- +*** New user option 'js-jsx-attribute-offset' for JSX attribute indents. + +--- +*** New variable 'js-syntactic-mode-name' controls mode name display. +Previously, the mode name was simply 'JavaScript'. Now, when a syntax +extension like JSX is enabled, the mode name is 'JavaScript[JSX]'. +Set this variable to nil to disable the new behavior. + +--- +*** New function 'js-use-syntactic-mode-name' for deriving modes. +Packages deriving from 'js-mode' with 'define-derived-mode' should +call this function to add enabled syntax extensions to their mode +name, too. + +** Autorevert + ++++ +*** New user option 'auto-revert-avoid-polling' for saving power. +When set to a non-nil value, buffers in Auto Revert mode are no longer +polled for changes periodically. This reduces the power consumption +of an idle Emacs, but may fail on some network file systems; set +'auto-revert-notify-exclude-dir-regexp' to match files where +notification is not supported. The default value is nil. + ++++ +*** New variable 'buffer-auto-revert-by-notification'. +A major mode can declare that notification on the buffer's default +directory is sufficient to know when updates are required, by setting +the new variable 'buffer-auto-revert-by-notification' to a non-nil +value. Auto Revert mode can use this information to avoid polling the +buffer periodically when 'auto-revert-avoid-polling' is non-nil. + +--- +*** 'global-auto-revert-ignore-buffer' can now also be a predicate +function that can be used for more fine-grained control of which +buffers to auto-revert. + +** auth-source-pass + ++++ +*** New user option 'auth-source-pass-filename'. +Allows setting the path to the password-store, defaults to +"~/.password-store". + ++++ +*** New user option 'auth-source-pass-port-separator'. +Specifies separator between host and port, defaults to colon ":". + +--- +*** Minimize the number of decryptions during password lookup. +This makes the package usable with physical tokens requiring touching +a sensor for every decryption. + +--- +*** 'auth-source-pass-get' is now autoloaded. + +** Bookmarks + +--- +*** 'bookmark-file' and 'bookmark-old-default-file' are now obsolete +aliases of 'bookmark-default-file'. + +--- +*** New user option 'bookmark-watch-bookmark-file'. +When non-nil, watch whether the bookmark file has changed on disk. + +--- +*** The old bookmark file format is no longer supported. +This bookmark file format has not been used in Emacs since at least +version 19.34, released in 1996, and will no longer be automatically +converted to the new bookmark file format. + +The following functions are now declared obsolete: +'bookmark-grok-file-format-version', +'bookmark-maybe-upgrade-file-format', +'bookmark-upgrade-file-format-from-0', and +'bookmark-upgrade-version-0-alist'. + +--- +** The mantemp.el library is now marked obsolete. +This library generates manual C++ template instantiations. It should +no longer be useful on modern compilers, which do this automatically. + +** Ispell + +--- +*** New hook 'ispell-change-dictionary-hook'. +This runs after changing the dictionary and could be used to +automatically spellcheck a buffer when changing language without +needing to advice 'ispell-change-dictionary'. + +** scroll-lock + +--- +*** New command 'scroll-lock-next-line-always-scroll'. +This command is bound to 'S-down' and scrolls the buffer up in +particular when the end of the buffer is visible in the window. + +** mwheel.el + +--- +*** 'mwheel-install' is now obsolete. +Use 'mouse-wheel-mode' instead. Note that 'mouse-wheel-mode' is +already enabled by default on most graphical displays. + +** Gravatar + ++++ +*** 'gravatar-cache-ttl' is now a number of seconds. +The previously used timestamp format of a list of integers is still +supported, but is deprecated. The default value has not changed. + ++++ +*** 'gravatar-size' can now be nil. +This results in the use of Gravatar's default size of 80 pixels. + ++++ +*** The default fallback gravatar is now configurable. +This is possible using the new user options 'gravatar-default-image' +and 'gravatar-force-default'. + +** ada-mode + +--- +*** The built-in ada-mode is now deleted. The GNU ELPA package is a +good replacement, even in very large source files. + +** time-stamp + +--- +*** New '%5z' conversion for 'time-stamp-format' gives time zone offset. +Specifying '%5z' in 'time-stamp-format' or 'time-stamp-pattern' +expands to the time zone offset, e.g., '+0100'. The time zone used is +specified by 'time-stamp-time-zone'. + +Because this feature is new in Emacs 27.1, do not use it in the local +variables section of any file that might be edited by an older version +of Emacs. + +--- +*** Some conversions recommended for 'time-stamp-format' have changed. +The new documented/recommended %-conversions are closer to those +used by 'format-time-string' and are compatible at least as far back +as Emacs 22.1 (released in 2007). + +Uppercase abbreviated day name of week: was %3A, now %#a +Full day name of week: was %:a, now %:A +Uppercase abbreviated month name: was %3B, now %#b +Full month name: was %:b, now %:B +Four-digit year: was %:y, now %Y +Lowercase timezone name: was %z, now %#Z +Fully-qualified host name: was %s, now %Q +Unqualified host name: (was none), now %q +Login name: was %u, now %l +User's full name: was %U, now %L + +Merely having '(add-hook 'before-save-hook 'time-stamp)' in your +Emacs init file does not expose you to this change. However, +if you set 'time-stamp-format' or 'time-stamp-pattern' with a +file-local variable, you may need to update the value. + +** mode-local + +--- +*** Declare 'define-overload' and 'define-child-mode' as obsolete. + +--- +*** Rename several internal functions to use a 'mode-local-' prefix. + +** CC Mode + ++++ +*** You can now flag "wrong style" comments with 'font-lock-warning-face'. +To do this, use 'c-toggle-comment-style', if needed, to set the desired +default comment style (block or line); then set the user option +'c-mark-wrong-style-of-comment' to non-nil. + +** Mailcap + +--- +*** The new function 'mailcap-file-name-to-mime-type' has been added. +It's a simple convenience function for looking up MIME types based on +file name extensions. + +--- +*** The default way the list of possible external viewers for MIME +types is sorted and chosen has changed. Earlier, the most specific +viewer was chosen, even if there was a general override in "~/.mailcap". +For instance, if "/etc/mailcap" has an entry for "image/gif", that one +will be chosen even if you have an entry for "image/*" in your +"~/.mailcap" file. But with the new method, entries from "~/.mailcap" +overrides all system and Emacs-provided defaults. To get the old +method back, set 'mailcap-prefer-mailcap-viewers' to nil. + +** MH-E ++++ +*** The hook 'mh-show-mode-hook' is now called before the message is inserted. +Functions that want to affect the message text (for example, to change +highlighting) can no longer use 'mh-show-mode-hook', because the +message contents will not yet have been inserted when the hook is +called. Such functions should now be attached to 'mh-show-hook'. + +** URL + +--- +*** The 'file:' handler no longer looks for "index.html" in +directories if you ask it for a "file:///dir" URL. Since this is a +low-level library, such decisions (if they are to be made at all) are +left to higher-level functions. + + +* New Modes and Packages in Emacs 27.1 + +** Tab Bars + ++++ +*** Tab Bar mode +The new command 'tab-bar-mode' enables the tab bar at the top of each +frame, where you can use tabs to switch between named persistent +window configurations. + +The 'C-x t' sequence is the new prefix key for tab-related commands: +'C-x t 2' creates a new tab; 'C-x t 0' deletes the current tab; +'C-x t b' switches to buffer in another tab; 'C-x t f' and 'C-x t C-f' +edit file in another tab; and 'C-TAB' and 'S-C-TAB' switch to the next +or previous tab. You can also switch between tabs and create/delete +tabs with a mouse. + +Tab-related commands are available even when 'tab-bar-mode' is +disabled: by default, they enable 'tab-bar-mode' in that case. + +The X resource "tabBar", class "TabBar" enables the tab bar +when its value is "on", "yes" or "1". + +The user option 'tab-bar-position' specifies where to show the tab bar. + +Read the new Info node "(emacs) Tab Bars" for full description +of all related features. + ++++ +*** Tab Line mode +The new command 'global-tab-line-mode' enables the tab line above each +window, which you can use to switch buffers in the window. Selecting +the previous window-local tab is the same as typing 'C-x <LEFT>' +('previous-buffer'), selecting the next tab is the same as 'C-x <RIGHT>' +('next-buffer'). Both commands support a numeric prefix argument as +a repeat count. Clicking on the plus icon adds a new buffer to the +window-local tab line of buffers. Using the mouse wheel on the tab +line scrolls tabs. + ++++ +** fileloop.el lets one setup multifile operations like search&replace. + ++++ +** Emacs can now visit files in archives as if they were directories. +This feature uses Tramp and works only on systems which support GVFS, +i.e. GNU/Linux, roughly spoken. See the node "(tramp) Archive file +names" in the Tramp manual for full documentation of these facilities. + ++++ +** New library for writing JSONRPC applications (https://jsonrpc.org). +The 'jsonrpc' library enables writing Emacs Lisp applications that +rely on this protocol. Since the protocol is designed to be +transport-agnostic, the library provides an API to implement new +transport strategies as well as a separate API to use them. A +transport implementation for process-based communication, such as is +used by the Language Server Protocol (LSP), is readily available. + ++++ +** Backtrace mode improves viewing of Elisp backtraces. +Backtrace mode adds pretty printing, fontification and ellipsis +expansion to backtrace buffers produced by the Lisp debugger, Edebug +and ERT. See the node "(elisp) Backtraces" in the Elisp manual for +documentation of the new mode and its commands. + ++++ +** so-long.el helps to mitigate performance problems with long lines. +When 'global-so-long-mode' has been enabled, visiting a file with very +long lines will (subject to configuration) cause the user's preferred +'so-long-action' to be automatically invoked (by default, the buffer's +major mode is replaced by 'so-long-mode'). In extreme cases this can +prevent delays of several minutes, and make Emacs responsive almost +immediately. Type 'M-x so-long-commentary' for full documentation. + + +* Incompatible Lisp Changes in Emacs 27.1 + +--- +** Incomplete destructive splicing support has been removed. +Support for Common Lisp style destructive splicing (",.") was +incomplete and broken for a long time. It has now been removed. + +This means that backquote substitution now works for identifiers +starting with a period ("."). Consider the following example: + + (let ((.foo 42)) `,.foo) + +In the past, this would have incorrectly evaluated to '(\,\. foo)', +but will now instead evaluate to '42'. + +--- +** The REGEXP in 'magic-mode-alist' is now matched case-sensitively. +Likewise for 'magic-fallback-mode-alist'. + ++++ +** 'add-hook' does not always add to the front or the end any more. +The replacement of 'append' with 'depth' implies that the function is +not always added to the very front (when append/depth is nil) or the +very end (when append/depth is t) any more because other functions on +the hook may have specified higher/lower depths. This makes it +possible to control the ordering of functions more precisely, as was +already possible in 'add-function' and 'advice-add'. + +--- +** In 'compilation-error-regexp-alist' the old undocumented feature +where 'line' could be a function of 2 arguments has been dropped. + +--- +** 'define-fringe-bitmap' is always defined, even when Emacs is built +without any GUI support. + +--- +** Just loading a theme's file no longer activates the theme's settings. +Loading a theme with 'M-x load-theme' still activates the theme, as it +did before. However, loading the theme's file with 'M-x load-file', +or using 'require' or 'load' in a Lisp program, doesn't actually apply +the theme's settings until you either invoke 'M-x enable-theme' or +type 'M-x load-theme'. (In a Lisp program, calling 'enable-theme' or +invoking 'load-theme' with NO-ENABLE argument omitted or nil has the +same effect of activating a theme whose file has been loaded.) The +special case of the 'user' theme is an exception: it is frequently +used for ad-hoc customizations, so the settings of that theme are by +default applied immediately. + +The variable 'custom--inhibit-theme-enable' controls this behavior; +its default value changed in Emacs 27.1. + +--- +** The REPETITIONS argument of 'benchmark-run' can now also be a variable. + +--- +** Interpretation of relative 'HOME' directory has changed. +If "$HOME" is set to a relative file name, 'expand-file-name' now +interprets it relative to the directory where Emacs was started, not +relative to the 'default-directory' of the current buffer. We recommend +always setting "$HOME" to an absolute file name, so that its meaning is +independent of where Emacs was started. + +--- +** 'file-name-absolute-p' no longer considers "~foo" to be an absolute +file name if there is no user named "foo". + ++++ +** The FILENAME argument to 'file-name-base' is now mandatory and no +longer defaults to 'buffer-file-name'. + ++++ +** File metadata primitives now signal an error if I/O, access, or +other serious errors prevent them from determining the result. +Formerly, these functions often (though not always) silently returned +nil. For example, if there is an access error, I/O error or low-level +integer overflow when getting the attributes of a file F, +'(file-attributes F)' now signals an error instead of returning nil. +These functions still behave as before if the only problem is that the +file does not exist. The affected primitives are +'directory-files-and-attributes', 'file-acl', 'file-attributes', +'file-modes', 'file-newer-than-file-p', 'file-selinux-context', +'file-system-info', and 'set-visited-file-modtime'. + +--- +** The function 'eldoc-message' now accepts a single argument. +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. + +--- +** Old-style backquotes now generate an error. +They have been generating warnings for a decade. To interpret +old-style backquotes as new-style, bind the new variable +'force-new-style-backquotes' to t. + +--- +** Defining a Common Lisp structure using 'cl-defstruct' or +'cl-struct-define' whose name clashes with a builtin type (e.g., +'integer' or 'hash-table') now signals an error. + +--- +** When formatting a floating-point number as an octal or hexadecimal +integer, Emacs now signals an error if the number is too large for the +implementation to format. + ++++ +** 'logb' now returns infinity when given an infinite or zero argument, +and returns a NaN when given a NaN. Formerly, it returned an extreme +fixnum for such arguments. + +--- +** Some functions and variables obsolete since Emacs 22 have been removed: +'archive-mouse-extract', 'assoc-ignore-case', 'assoc-ignore-representation', +'backward-text-line', 'blink-cursor', 'bookmark-exit-hooks', +'c-opt-op-identitier-prefix', 'comint-use-prompt-regexp-instead-of-fields', +'compilation-finish-function', 'count-text-lines', 'cperl-vc-header-alist', +'custom-face-save-command', 'cvs-display-full-path', 'cvs-fileinfo->full-path', +'delete-frame-hook', 'derived-mode-class', 'describe-char-after', +'describe-project', 'desktop-basefilename', 'desktop-buffer-handlers', +'desktop-buffer-misc-functions', 'desktop-buffer-modes-to-save', +'desktop-enable', 'desktop-load-default', 'dired-omit-files-p', +'disabled-command-hook', 'dungeon-mode-map', 'electric-nroff-mode', +'electric-nroff-newline', 'electric-perl-terminator', 'focus-frame', +'forward-text-line', 'generic-define-mswindows-modes', +'generic-define-unix-modes', 'generic-font-lock-defaults', +'goto-address-at-mouse', 'highlight-changes-colours', +'ibuffer-elide-long-columns', 'ibuffer-hooks', 'ibuffer-mode-hooks', +'icalendar-convert-diary-to-ical', 'icalendar-extract-ical-from-buffer', +'imenu-always-use-completion-buffer-p', 'ipconfig-program', +'ipconfig-program-options', 'isearch-lazy-highlight-cleanup', +'isearch-lazy-highlight-initial-delay', 'isearch-lazy-highlight-interval', +'isearch-lazy-highlight-max-at-a-time', 'iswitchb-use-fonts', +'latin1-char-displayable-p', 'mouse-wheel-click-button', +'mouse-wheel-down-button', 'mouse-wheel-up-button', 'new-frame', +'pascal-outline', 'process-kill-without-query', +'recentf-menu-append-commands-p', 'rmail-pop-password', +'rmail-pop-password-required', 'savehist-load', 'set-default-font', +'spam-list-of-processors', 'speedbar-add-ignored-path-regexp', +'speedbar-buffers-line-path', 'speedbar-ignored-path-expressions', +'speedbar-ignored-path-regexp', 'speedbar-line-path', 'speedbar-path-line', +'timer-set-time-with-usecs', 'tooltip-gud-display', 'tooltip-gud-modes', +'tooltip-gud-toggle-dereference', 'unfocus-frame', 'unload-hook-features-list', +'update-autoloads-from-directories', 'vc-comment-ring', 'vc-comment-ring-index', +'vc-comment-search-forward', 'vc-comment-search-reverse', +'vc-comment-to-change-log', 'vc-diff-switches-list', 'vc-next-comment', +'vc-previous-comment', 'view-todo', 'x-lost-selection-hooks', +'x-sent-selection-hooks'. + +--- +** Further functions and variables obsolete since Emacs 24 have been removed: +'default-directory-alist', 'dired-default-directory', +'dired-default-directory-alist', 'dired-enable-local-variables', +'dired-hack-local-variables', 'dired-local-variables-file', +'dired-omit-here-always'. + ++++ +** Garbage collection no longer treats miscellaneous objects specially; +they are now allocated like any other pseudovector. As a result, the +'garbage-collect' and 'memory-use-count' functions no longer return a +'misc' component, and the 'misc-objects-consed' variable has been +removed. + ++++ +** Reversed character ranges are no longer permitted in 'rx'. +Previously, ranges where the starting character is greater than the +ending character were silently omitted. +For example, '(rx (any "@z-a" (?9 . ?0)))' would match '@' only. +Now, such 'rx' expressions generate an error. + +--- +** Internal 'rx' functions and variables have been removed, +as a consequence of an improved implementation. Packages using +these should use the public 'rx' and 'rx-to-string' instead. +'rx-constituents' is still available for compatibility, but the new +extension mechanism is preferred: 'rx-define', 'rx-let' and +'rx-let-eval'. + ++++ +** 'text-mode' no longer sets the value of 'indent-line-function'. +The global value of 'indent-line-function', which defaults to +'indent-relative', will no longer be reset locally when turning on +'text-mode'. + +To get back the old behavior, add a function to 'text-mode-hook' which +performs '(setq-local indent-line-function #'indent-relative)'. + +--- +** 'make-process' no longer accepts a non-nil ':stop' key. This has +never worked reliably, and now causes an error. + ++++ +** 'eventp' no longer returns non-nil for lists whose car is nil. +This is consistent with the fact that nil, though a symbol, is not a +valid event type. + +--- +** The obsolete package xesam.el (since Emacs 24) has been removed. + ++++ +** The XBM image handler now accepts a ':stride' argument, which should +be specified in image specs representing the entire bitmap as a single +bool vector. + ++++ +** 'regexp-quote' may return its argument string. +If the argument needs no quoting, it can be returned instead of a copy. + ++++ +** Mouse scroll up and down with control key modifier changes font size. +Previously, the control key modifier was used to scroll up or down by +an amount which was close to near a full screen. This is now instead +available by scrolling with the meta modifier key. + +To get the old behavior back, customize the user option +'mouse-wheel-scroll-amount', or add the following to your init file: + +(customize-set-variable 'mouse-wheel-scroll-amount + '(5 ((shift) . 1) ((control) . nil))) + +By default, the font size will be changed in the window that the mouse +pointer is over. To change this behavior, you can customize the user +option 'mouse-wheel-follow-mouse'. Note that this will also affect +scrolling. + ++++ +** Mouse scroll up and down with control key modifier also works on images +where it scales the image under the mouse pointer. + +--- +** 'help-follow-symbol' now signals 'user-error' if point (or the +position pointed to by the argument POS) is not in a symbol. + +--- +** The options.el library has been removed. +It was obsolete since Emacs 22.1, replaced by customize. + +--- +** The tls.el and starttls.el libraries are now marked obsolete. +Use of built-in libgnutls based functionality (described in the Emacs +GnuTLS manual) is recommended instead. + +--- +** The url-ns.el library is now marked obsolete. +This library is used to open configuration files for the long defunct +web browser Netscape, and is no longer relevant. + + +* Lisp Changes in Emacs 27.1 + ++++ +** Emacs Lisp integers can now be of arbitrary size. +Emacs uses the GNU Multiple Precision (GMP) library to support +integers whose size is too large to support natively. The integers +supported natively are known as "fixnums", while the larger ones are +"bignums". The new predicates 'bignump' and 'fixnump' can be used to +distinguish between these two types of integers. + +All the arithmetic, comparison, and logical (a.k.a. "bitwise") +operations where bignums make sense now support both fixnums and +bignums. However, note that unlike fixnums, bignums will not compare +equal with 'eq', you must use 'eql' instead. (Numerical comparison +with '=' works on both, of course.) + +Since large bignums consume a lot of memory, Emacs limits the size of +the largest bignum a Lisp program is allowed to create. The +nonnegative value of the new variable 'integer-width' specifies the +maximum number of bits allowed in a bignum. Emacs signals an integer +overflow error if this limit is exceeded. + +Several primitive functions formerly returned floats or lists of +integers to represent integers that did not fit into fixnums. These +functions now simply return integers instead. Affected functions +include functions like 'encode-char' that compute code-points, functions +like 'file-attributes' that compute file sizes and other attributes, +functions like 'process-id' that compute process IDs, and functions like +'user-uid' and 'group-gid' that compute user and group IDs. + ++++ +** 'overflow-error' is now documented as a subcategory of 'range-error'. +Formerly it was undocumented, and was (incorrectly) a subcategory +of 'domain-error'. + +** Time values + ++++ +*** New function 'time-convert' converts Lisp time values to Lisp +timestamps of various forms, including a new timestamp form '(TICKS +. HZ)' where TICKS is an integer and HZ a positive integer denoting a +clock frequency. + ++++ +*** Although the default timestamp format is still '(HI LO US PS)', +it is planned to change in a future Emacs version, to exploit bignums. +The documentation has been updated to mention that the timestamp +format may change and that programs should use functions like +'format-time-string', 'decode-time', and 'time-convert' rather than +probing the innards of a timestamp directly, or creating a timestamp +by hand. + ++++ +*** Decoded (calendrical) timestamps now have subsecond resolution. +This affects 'decode-time', which generates these timestamps, as well +as functions like 'encode-time' that accept them. The subsecond info +is present as a '(TICKS . HZ)' value in the seconds element of a +decoded timestamp, and 'decode-time' has a new optional FORM argument +specifying the form of the seconds member. For example, if X is the +timestamp '(1566009571321878186 . 1000000000)', which represents +"2019-08-17 02:39:31.321878186 UTC", '(decode-time X t t)' returns +'((31321878186 . 1000000000) 39 2 17 8 2019 6 nil 0)' instead of the +traditional '(31 39 2 17 8 2019 6 nil 0)' returned by plain +'(decode-time X t)'. Although the default FORM is currently +'integer', which truncates the seconds to an integer and is the +traditional behavior, this default may change in future Emacs +versions, so callers requiring an integer should specify FORM +explicitly. + ++++ +*** 'encode-time' supports a new API '(encode-time TIME)'. +The old 'encode-time' API is still supported. + ++++ +*** A new package to parse ISO 8601 time, date, durations and +intervals has been added. The main function to use is +'iso8601-parse', but there's also 'iso8601-parse-date', +'iso8601-parse-time', 'iso8601-parse-duration' and +'iso8601-parse-interval'. All these functions return decoded time +structures, except the final one, which returns three of them (start, +end and duration). + ++++ +*** 'time-add', 'time-subtract', and 'time-less-p' now accept +infinities and NaNs too, and propagate them or return nil like +floating-point operators do. If both arguments are finite, these +functions now return exact results instead of rounding in some cases, +and they also avoid excess precision when that is easy. + ++++ +*** New function 'time-equal-p' compares time values for equality. + ++++ +*** 'format-time-string' supports a new conversion specifier flag '+' +that acts like the '0' flag but also puts a '+' before nonnegative +years containing more than four digits. This is for compatibility +with POSIX.1-2017. + ++++ +*** To access (or alter) the elements of a decoded time value, the +'decoded-time-second', 'decoded-time-minute', 'decoded-time-hour', +'decoded-time-day', 'decoded-time-month', 'decoded-time-year', +'decoded-time-weekday', 'decoded-time-dst' and 'decoded-time-zone' +accessors can be used. + +*** The new functions 'date-days-in-month' (which will say how many +days there are in a month in a specific year), 'date-ordinal-to-time' +(that computes the date of an ordinal day), 'decoded-time-add' (for +doing computations on a decoded time structure), 'make-decoded-time' +(for making a decoded time structure with only the given keywords +filled out), and 'encoded-time-set-defaults' (which fills in nil +elements as if it's midnight January 1st, 1970) have been added. + ++++ +*** In the DST slot, 'encode-time' and 'parse-time-string' now return -1 +if it is not known whether daylight saving time is in effect. +Formerly they were inconsistent: 'encode-time' returned t in this +situation, whereas 'parse-time-string' returned nil. Now they +consistently use nil to mean that DST is not in effect, and use -1 +to mean that it is not known whether DST is in effect. + ++++ +** New macro 'benchmark-progn'. +This macro works like 'progn', but messages how long it takes to +evaluate the body forms. The value of the last form is the return +value. + ++++ +** New function 'read-char-from-minibuffer'. +This function works like 'read-char', but uses 'read-from-minibuffer' +to read a character, so it maintains a history that can be navigated +via usual minibuffer keystrokes 'M-p'/'M-n'. + +--- +** New variables 'set-message-function' and 'clear-message-function' +can be used to specify functions to show and clear messages that +normally are displayed in the echo area. + ++++ +** 'setq-local' can now set an arbitrary number of variables, which +makes the syntax more like 'setq'. + +--- +** 'reveal-mode' can now also be used for more than to toggle between +invisible and visible: It can also toggle 'display' properties in +overlays. This is only done on 'display' properties that have the +'reveal-toggle-invisible' property set. + ++++ +** 'process-contact' now takes an optional NO-BLOCK argument to allow +not waiting for a process to be set up. + +--- +** New variable 'read-process-output-max' controls sub-process throughput. +This variable determines how many bytes can be read from a sub-process +in one read operation. The default, 4096 bytes, was previously a +hard-coded constant. Setting it to a larger value might enhance +throughput of reading from sub-processes that produces vast +(megabytes) amounts of data in one go. + ++++ +** The new user option 'quit-window-hook' is now run first when +executing the 'quit-window' command. + +** The user options 'help-enable-completion-auto-load', +'help-enable-auto-load' and 'vhdl-project-auto-load', as well as the +function 'vhdl-auto-load-project' have been renamed to have "autoload" +without the hyphen in their names. Obsolete aliases from the old +names have been added. + ++++ +** Buttons (created with 'make-button' and related functions) can +now use the 'button-data' property. If present, the data in this +property will be passed on to the 'action' function instead of the +button itself in 'button-activate'. + ++++ +** 'defcustom' now takes a ':local' keyword that can be either t or +'permanent', which mean that the variable should be automatically +buffer-local. 'permanent' also sets the variable's 'permanent-local' +property. + ++++ +** The new macro 'with-suppressed-warnings' can be used to suppress +specific byte-compile warnings. + ++++ +** The new macro 'ignore-error' is like 'ignore-errors', but takes a +specific error condition, and will only ignore that condition. (This +can also be a list of conditions.) + +--- +** The new function 'byte-compile-info-message' can be used to output +informational messages that look pleasing during the Emacs build. + +--- +** New 'help-fns-describe-variable-functions' hook. +It makes it possible to add metadata information to 'describe-variable'. + +** i18n (internationalization) + +--- +*** 'ngettext' can be used now to return the right plural form +according to the given numeric value. + ++++ +** 'inhibit-null-byte-detection' is renamed to 'inhibit-nul-byte-detection'. + ++++ +** 'self-insert-command' takes the char to insert as (optional) argument. + ++++ +** 'lookup-key' can take a list of keymaps as argument. + ++++ +** 'condition-case' now accepts t to match any error symbol. + ++++ +** New function 'proper-list-p'. +Given a proper list as argument, this predicate returns its length; +otherwise, it returns nil. 'format-proper-list-p' is now an obsolete +alias for the new function. + +--- +** 'define-minor-mode' automatically documents the meaning of ARG. + ++++ +** The function 'recenter' now accepts an additional optional argument. +By default, calling 'recenter' will not redraw the frame even if +'recenter-redisplay' is non-nil. Call 'recenter' with the new second +argument non-nil to force redisplay per 'recenter-redisplay's value. + ++++ +** New functions 'major-mode-suspend' and 'major-mode-restore'. +Use them when switching temporarily to another major mode, e.g. for +'hexl-mode', or to switch between 'c-mode' and 'image-mode' in XPM. + ++++ +** New macro 'dolist-with-progress-reporter'. +This works like 'dolist', but reports progress similar to +'dotimes-with-progress-reporter'. + ++++ +** New hook 'after-delete-frame-functions'. +This works like 'delete-frame-functions', but runs after the frame to +be deleted has been made dead and removed from the frame list. + +--- +** The function 'provided-mode-derived-p' was extended to support aliases. +The function now returns non-nil when the argument MODE is derived +from any alias of any of MODES. + ++++ +** New frame focus state inspection interface. +The hooks 'focus-in-hook' and 'focus-out-hook' are now obsolete. +Instead, attach to 'after-focus-change-function' using 'add-function' +and inspect the focus state of each frame using 'frame-focus-state'. + ++++ +** Emacs now requests and recognizes focus-change notifications from TTYs. +On terminal emulators that support the feature, Emacs can now support +'focus-in-hook' and 'focus-out-hook' for TTY frames. + ++++ +** Window-specific face remapping. +Face specifications (of the kind used in 'face-remapping-alist') +now support filters, allowing faces to vary between different windows +displaying the same buffer. See the node "(elisp) Face Remapping" +of the Emacs Lisp Reference manual for more detail. + ++++ +** Window change functions have been redesigned. +Hooks reacting to window changes run now only when redisplay detects +that a change has actually occurred. Six hooks are now provided: +'window-buffer-change-functions' (run after window buffers have +changed), 'window-size-change-functions' (run after a window was +assigned a new buffer or size), 'window-configuration-change-hook' +(like the former but run also when a window was deleted), +'window-selection-change-functions' (run when the selected window +changed) and 'window-state-change-functions' and +'window-state-change-hook' (run when any of the preceding ones is +run). Applications can enforce running the latter two using the new +function 'set-frame-window-state-change'. 'window-scroll-functions' +are unaffected by these changes. + +In addition, a number of functions now allow the caller to detect what +has changed since last redisplay: 'window-old-buffer' returns for any +window the buffer it showed at that time. 'old-selected-window' and +'old-selected-frame' return the window and frame that were selected +during last redisplay. 'window-old-pixel-width' (renamed from +'window-pixel-width-before-size-change'), 'window-old-pixel-height' +(renamed from 'window-pixel-height-before-size-change'), +'window-old-body-pixel-width' and 'window-old-body-pixel-height' +return the total and body sizes of any window during last redisplay. + +Also 'run-window-configuration-change-hook' is declared obsolete. + +See the section "(elisp) Window Hooks" in the Elisp manual for a +detailed explanation of the new behavior. + ++++ +** Scroll bar and fringe settings can now be made persistent for windows. +The functions 'set-window-scroll-bars' and 'set-window-fringes' now +have a new optional argument that makes the settings they produce +reliably survive subsequent invocations of 'set-window-buffer'. + ++++ +** New user option 'resize-mini-frames'. +This option allows automatically resizing minibuffer-only frames +similarly to how minibuffer windows are resized on "normal" frames. + ++++ +** New buffer display action function 'display-buffer-in-direction'. +This function allows specifying the location of the window chosen by +'display-buffer' in various ways. + ++++ +** New buffer display action alist entry 'dedicated'. +Such an entry allows specifying the dedicated status of a window +created by 'display-buffer'. + ++++ +** New buffer display action alist entry 'window-min-height'. +Such an entry allows specifying a minimum height of the window used +for displaying a buffer. 'display-buffer-below-selected' is the only +action function to respect it at the moment. + ++++ +** New buffer display action alist entry 'direction'. +This entry is used to specify the location of the window chosen by +'display-buffer-in-direction'. + ++++ +** Additional meaning of display action alist entry 'window'. +A 'window' entry can now also specify a reference window for +'display-buffer-in-direction'. + ++++ +** The function 'assoc-delete-all' now takes an optional predicate argument. + ++++ +** New function 'string-distance' to calculate the Levenshtein distance +between two strings. + ++++ +** 'print-quoted' now defaults to t, so if you want to see +'(quote x)' instead of 'x you will have to bind it to nil where applicable. + ++++ +** Numbers formatted via '%o' or '%x' are now formatted as signed integers. +This avoids problems in calls like '(read (format "#x%x" -1))', and is +more compatible with bignums. To get the traditional machine-dependent +behavior, set the experimental variable 'binary-as-unsigned' to t, +and if the new behavior breaks your code please email +<32252@debbugs.gnu.org>. Because '%o' and '%x' can now format signed +integers, they now support the '+' and space flags. + ++++ +** In Emacs Lisp mode, symbols with confusable quotes are highlighted. +For example, the first character in '‘foo' would be highlighted in +'font-lock-warning-face'. + ++++ +** Omitting variables after '&optional' and '&rest' is now allowed. +For example '(defun foo (&optional))' is no longer an error. This is +sometimes convenient when writing macros. See the ChangeLog entry +titled "Allow '&rest' or '&optional' without following variable +(Bug#29165)" for a full listing of which arglists are accepted across +versions. + +--- +** Internal parsing commands now use 'syntax-ppss' and disregard +'open-paren-in-column-0-is-defun-start'. This affects mostly things like +'forward-comment', 'scan-sexps', and 'forward-sexp' when parsing backward. +The new variable 'comment-use-syntax-ppss' can be set to nil to recover +the old behavior if needed. +This also means that there is no longer any need to precede opening +brackets at the start of a line inside documentation strings with a +backslash, although there is no harm in doing so to make the code +easier to edit with an older Emacs version. + +--- +** The 'server-name' and 'server-socket-dir' variables are set when a +socket has been passed to Emacs. + +--- +** The 'file-system-info' function is now available on all platforms. +instead of just Microsoft platforms. This fixes a 'get-free-disk-space' +bug on OS X 10.8 and later. + +--- +** The function 'get-free-disk-space' returns now a non-nil value for +remote systems, which support this check. + ++++ +** 'memory-limit' now returns a better estimate of memory consumption. + ++++ +** When interpreting 'gc-cons-percentage', Emacs now estimates the +heap size more often and (we hope) more accurately. E.g., formerly +'(progn (let ((gc-cons-percentage 0.8)) BODY1) BODY2)' continued to use +the 0.8 value during BODY2 until the next garbage collection, but that +is no longer true. Applications may need to re-tune their GC tricks. + ++++ +** New macro 'combine-change-calls' arranges to call the change hooks +('before-change-functions' and 'after-change-functions') just once +each around a sequence of lisp forms, given a region. This is +useful when a function makes a possibly large number of repetitive +changes and the change hooks are time consuming. + ++++ +** 'eql', 'make-hash-table', etc. now treat NaNs consistently. +Formerly, some of these functions ignored signs and significands of +NaNs. Now, all these functions treat NaN signs and significands as +significant. For example, '(eql 0.0e+NaN -0.0e+NaN)' now returns nil +because the two NaNs have different signs; formerly it returned t. +Also, Emacs now reads and prints NaN significands; e.g., if X is a +NaN, '(format "%s" X)' now returns "0.0e+NaN", "1.0e+NaN", etc., +depending on X's significand. + ++++ +** The function 'make-string' accepts an additional optional argument. +If the optional third argument is non-nil, 'make-string' will produce +a multibyte string even if its second argument is an ASCII character. + +--- +** '(format "%d" X)' no longer mishandles a floating-point number X that +does not fit in a machine integer. + +--- +** New coding-system 'ibm038'. +This is the International EBCDIC encoding, also available as aliases +'ebcdic-int' and 'cp038'. + +--- +** New JSON parsing and serialization functions 'json-serialize', +'json-insert', 'json-parse-string', and 'json-parse-buffer'. These +are implemented in C using the Jansson library. + ++++ +** New function 'ring-resize'. +'ring-resize' can be used to grow or shrink a ring. + ++++ +** New function 'flatten-tree'. +'flatten-list' is provided as an alias. These functions take a tree +and 'flatten' it such that the result is a list of all the terminal +nodes. + ++++ +** 'zlib-decompress-region' can partially decompress corrupted data. +If the new optional ALLOW-PARTIAL argument is passed, then the data +that was decompressed successfully before failing will be inserted +into the buffer. + +** Image mode + +--- +*** New library Exif. +An Exif library has been added that can parse JPEG files and output +data about creation times and orientation and the like. +'exif-parse-file' and 'exif-parse-buffer' are the main interface +functions. + +--- +*** 'image-mode' now uses this library to automatically rotate images +according to the orientation in the Exif data, if any. + +--- +*** New library image-converter. +If you need to view exotic image formats for which Emacs doesn't have +native support, customize the new user option +'image-use-external-converter' to t. If your system has +GraphicsMagick, ImageMagick or 'ffmpeg' installed, they will then be +used to convert images automatically before displaying them. + +--- +*** 'auto-mode-alist' now includes many of the types typically +supported by the external image converters, like WEPB, BMP and ICO. +These now default to using 'image-mode'. + +--- +*** 'imagemagick-types-inhibit' disables using ImageMagick by default. +'image-mode' started using ImageMagick by default for all images +some years back. It now respects 'imagemagick-types-inhibit' as a way +to disable that. + +--- +*** Some 'image-mode' variables are now buffer-local. +The image parameters 'image-transform-rotation', +'image-transform-scale' and 'image-transform-resize' are now declared +buffer-local, so each buffer could have its own values for these +parameters. + ++++ +*** Three new 'image-mode' commands have been added: 'm', which marks +the file in the dired buffer(s) for the directory the file is in; 'u', +which unmarks the file; and 'w', which pushes the current buffer's file +name to the kill ring. + ++++ +*** The command 'image-rotate' now accepts a prefix argument. +With a prefix argument, 'image-rotate' now rotates the image at point +90 degrees counter-clockwise, instead of the default clockwise. + +** Modules + +--- +*** The function 'load' now behaves correctly when loading modules. +Specifically, it puts the module name into 'load-history', prints +loading messages if requested, and protects against recursive loads. + ++++ +*** New module environment function 'process_input' to process user +input while module code is running. + ++++ +*** New module environment functions 'make_time' and 'extract_time' to +convert between timespec structures and Emacs Lisp time values. + ++++ +*** New module environment functions 'make_big_integer' and +'extract_big_integer' to create and extract arbitrary-size integer +values. + ++++ +*** emacs-module.h now defines a macro 'EMACS_MAJOR_VERSION' that expands +to the major version of the latest Emacs supported by the header. + ++++ +** The function 'read-variable' now uses its own history list. +The history of variable names read by 'read-variable' is recorded in +the new variable 'custom-variable-history'. + +--- +** The functions 'string-to-unibyte' and 'string-to-multibyte' are no +longer declared obsolete. We have found that there are legitimate use +cases for these functions, where there's no better alternative. We +believe that the incorrect uses of these functions all but disappeared +by now, so we are un-obsoleting them. + ++++ +** New function 'group-name' returns a group name corresponding to GID. + ++++ +** 'make-process' now takes a keyword argument ':file-handler'; if +that is non-nil, it will look for a file name handler for the current +buffer's 'default-directory' and invoke that file name handler to make +the process. That way 'make-process' can start remote processes. + ++++ +** '(locale-info 'paper)' now returns the paper size on systems that support it. +This is currently supported on GNUish hosts and on modern versions of +MS-Windows. + ++++ +** The function 'regexp-opt', when given an empty list of strings, now +returns a regexp that never matches anything, which is an identity for +this operation. Previously, the empty string was returned in this +case. + ++++ +** New constant 'regexp-unmatchable' contains a never-matching regexp. +It is a convenient and readable way to specify a regexp that should +not match anything, and is as fast as any such regexp can be. + ++++ +** New functions to handle the URL variant of base-64 encoding. +New functions 'base64url-encode-string' and 'base64url-encode-region' +implement the url-variant of base-64 encoding as defined in RFC4648. + +The functions 'base64-decode-string' and 'base64-decode-region' now +accept an optional argument to decode the URL variant of base-64 +encoding. + ++++ +** The function 'file-size-human-readable' accepts more optional arguments. +The new third argument is a string put between the number and unit; it +defaults to the empty string. The new fourth argument is a string +representing the unit to use; it defaults to "B" when the second +argument is 'iec' and the empty string otherwise. We recommend a +space or non-breaking space as third argument, and "B" as fourth +argument, circumstances allowing. + ++++ +** 'format-spec' has been expanded with several modifiers to allow +greater flexibility when customizing variables. The modifiers include +zero-padding, upper- and lower-casing, and limiting the length of the +interpolated strings. The function has now also been documented in +the Emacs Lisp manual. + ++++ +** 'directory-files-recursively' can now take an optional PREDICATE +parameter to control descending into subdirectories, and a +FOLLOW-SYMLINK parameter to say that symbolic links that point to +other directories should be followed. + ++++ +** New function 'xor' returns the boolean exclusive-or of its args. +The function was previously defined in array.el, but has been moved to +subr.el so that it is available by default. It now always returns the +non-nil argument when the other is nil. Several duplicates of 'xor' +in other packages are now obsolete aliases of 'xor'. + ++++ +** 'define-globalized-minor-mode' now takes BODY forms. + ++++ +** New text property 'help-echo-inhibit-substitution'. +Setting this on the first character of a help string disables +conversions via 'substitute-command-keys'. + ++++ +** New text property 'minibuffer-message'. +Setting this on a character of the minibuffer text will display the +temporary echo messages before that character, when messages need to +be displayed while minibuffer is active. + ++++ +** 'undo' can be made to ignore the active region for a command +by setting 'undo-inhibit-region' symbol property of that command to +non-nil. This is used by 'mouse-drag-region' to make the effect +easier to undo immediately afterwards. + +--- +** When called interactively, 'next-buffer' and 'previous-buffer' now +signal 'user-error' if there is no buffer to switch to. + + +* Changes in Emacs 27.1 on Non-Free Operating Systems + +--- +** Battery status is now supported in all Cygwin builds. +Previously it was supported only in the Cygwin-w32 build. + +** Emacs now handles key combinations involving the macOS "command" +and "option" modifier keys more correctly. + +** MacOS modifier key behavior is now more adjustable. +The behavior of the macOS "Option", "Command", "Control" and +"Function" keys can now be specified separately for use with +ordinary keys, function keys and mouse clicks. This allows using them +in their standard macOS way for composing characters. + +** The special handling of 'frame-title-format' on NS where setting it +to t would enable the macOS proxy icon has been replaced with a +separate variable, 'ns-use-proxy-icon'. 'frame-title-format' will now +work as on other platforms. + +--- +** New primitive 'w32-read-registry'. +This primitive lets Lisp programs access the MS-Windows Registry by +retrieving values stored under a given key. It is intended to be used +for supporting features such as XDG-like location of important files +and directories. + ++++ +** The default value of 'w32-pipe-read-delay' is now zero. +This speeds up reading output from sub-processes that produce a lot of +data. + +This variable may need to be non-zero only when running DOS programs +as Emacs subprocesses, which by now is not supported on modern +versions of MS-Windows. Set this variable to 50 if for some reason +you need the old behavior (and please report such situations to Emacs +developers). + +--- +** New variable 'w32-multibyte-code-page'. +This variable holds the value of the multibyte code page used by the +system. It is usually zero, which indicates that 'w32-ansi-code-page' +is being used, except in Far Eastern locales. When this variable is +non-zero, Emacs at startup sets 'locale-coding-system' to the +corresponding encoding, instead of using 'w32-ansi-code-page'. + +--- +** The default value of 'inhibit-compacting-font-caches' is t on MS-Windows. +Experience shows that compacting font caches causes more trouble on +MS-Windows than it helps. + ++++ +** Font lookup on MS-Windows was improved to support rare scripts. +To activate the improvement, run the new function +'w32-find-non-USB-fonts' once per Emacs session, or assign to the new +variable 'w32-non-USB-fonts' the list of scripts and the corresponding +fonts. See the documentation of this function and variable in the +Emacs manual for more details. + ++++ +** On NS the behavior of drag and drop can now be modified by use of +modifier keys in line with Apples guidelines. This makes the drag and +drop behavior more consistent, as previously the sending application +was able to 'set' modifiers without the knowledge of the user. + +** On NS multicolor font display is enabled again since it is also +implemented in Emacs on free operating systems via Cairo drawing. + + +---------------------------------------------------------------------- +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 <https://www.gnu.org/licenses/>. + + +Local variables: +coding: utf-8 +mode: outline +paragraph-separate: "[ ]*$" +end: diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 9e4a631c729..4ce738d9a54 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -318,6 +318,83 @@ element from LD_LIBRARY_PATH before starting emacs proper. Or you could recompile Emacs with an -Wl,-rpath option that gives the location of the correct libotf. +* Problems when reading or debugging Emacs C code + +Because Emacs does not install a copy of its C source code, users +normally cannot easily read that code via commands like 'M-x +describe-function' (C-h f) that display the definition of a function. +However, some GNU/Linux systems provide separate packages containing +this source code which can get C-h f to work if you are willing to do +some tinkering, and some systems also provide packages containing +debug info, which when combined with the source can be used to debug +Emacs at the C level. + +** Debian-based source and debuginfo + +On recent Debian-based systems, you can obtain and use a source +package of Emacs as follows. + +*** Add the appropriate URI to /etc/apt/sources.list. + +To do this, become superuser and uncomment or add the appropriate +'deb-src' line. Details depend on the distribution. + +*** Execute a command like 'apt-get source emacs'. + +On older systems, append the top-level version number, e.g., 'apt-get +source emacs25'. The target directory for unpacking the source tree +is the current directory. + +*** Set find-function-C-source-directory accordingly. + +Once you have installed the source package, for example at +/home/myself/deb-src/emacs-26.3, add the following line to your +startup file: + + (setq find-function-C-source-directory + "/home/myself/deb-src/emacs-26.3/src/") + +The installation directory of the Emacs source package will contain +the exact package name and version number of Emacs that is installed +on your system. If a new Emacs package is installed, the source +package must be reinstalled as well, and the setting in your startup +file must be updated. + +*** Debian-based debuginfo + +You can also install a debug package of Emacs with a command like +'apt-get install emacs-dbg' (on older systems, 'apt-get install +emacs25-dbg'). You need to arrange for GDB to find where you +installed the source code, e.g., by using GDB's 'directory' command. + +** Red Hat-based source and debuginfo + +On recent Red Hat-based systems, you can install source and debug info +via superuser commands like the following: + + # Add the *-debuginfo repositories (exact command depends on system). + dnf config-manager --set-enabled fedora-debuginfo updates-debuginfo' + + # Install Emacs source and debug info. + dnf install emacs-debugsource + +To get describe-function and similar commands to work, you can then +add something like the following to your startup file: + + (setq find-function-C-source-directory + "/usr/src/debug/emacs-26.3-1.fc31.x86_64/src/") + +However, the exact directory name will depend on the system, and you +will need to both upgrade source and debug info when your system +upgrades or patches Emacs, and change your startup file accordingly. + +** Source and debuginfo for other systems + +If your system follows neither the Debian nor the Red Hat patterns, +you can obtain the source and debuginfo by obtaining the source code +of Emacs, building Emacs with the appropriate debug flags enabled, and +running the just-built Emacs. + * General runtime problems ** Lisp problems diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index ffa073f3da7..0d210b45452 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -40,7 +40,7 @@ \newlength{\ColThreeWidth} \setlength{\ColThreeWidth}{25mm} -\newcommand{\versionemacs}[0]{27} % version of Emacs this is for +\newcommand{\versionemacs}[0]{28} % version of Emacs this is for \newcommand{\cyear}[0]{2020} % copyright year \newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt index 3473fb693c1..7d5c64c86c0 100644 --- a/etc/srecode/el.srt +++ b/etc/srecode/el.srt @@ -102,7 +102,7 @@ $<MODEFCN:declaration:function$ comment-start ";;" comment-end "") (set (make-local-variable 'comment-start-skip) - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (set-syntax-table $MODESYM$-mode-syntax-table) (use-local-map $MODESYM$-mode-map) (set (make-local-variable 'font-lock-defaults) diff --git a/lib/_Noreturn.h b/lib/_Noreturn.h index 0d4b9c29e02..394ca3c2aa2 100644 --- a/lib/_Noreturn.h +++ b/lib/_Noreturn.h @@ -28,7 +28,10 @@ # define _Noreturn [[noreturn]] # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ - || 4 < __GNUC__ + (7 <= __GNUC_MINOR__))) + || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \ + || (defined __apple_build_version__ \ + ? 6000000 <= __apple_build_version__ \ + : 3 < __clang_major__ + (5 <= __clang_minor__)))) /* _Noreturn works as-is. */ # elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C # define _Noreturn __attribute__ ((__noreturn__)) diff --git a/lib/alloca.in.h b/lib/alloca.in.h index 228f9a0a29b..c7187e66ae3 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -1,7 +1,7 @@ /* Memory allocation on the stack. - Copyright (C) 1995, 1999, 2001-2004, 2006-2020 Free Software - Foundation, Inc. + Copyright (C) 1995, 1999, 2001-2004, 2006-2020 Free Software Foundation, + Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published diff --git a/lib/binary-io.h b/lib/binary-io.h index 64223f16fc2..477b4bf4dd3 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -1,6 +1,5 @@ /* Binary mode I/O. - Copyright (C) 2001, 2003, 2005, 2008-2020 Free Software Foundation, - Inc. + Copyright (C) 2001, 2003, 2005, 2008-2020 Free Software Foundation, Inc. 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 diff --git a/lib/c++defs.h b/lib/c++defs.h index 7a057633883..3e6aaabc9ce 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h @@ -301,9 +301,6 @@ _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \ "The symbol ::" #func " refers to the system function. " \ "Use " #namespace "::" #func " instead.") -# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING -# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ - extern __typeof__ (func) func # else # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ _GL_EXTERN_C int _gl_cxxalias_dummy diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 42891bb1683..fbd11b34508 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -5,8 +5,7 @@ <ctype.h> functions' behaviour depends on the current locale set via setlocale. - Copyright (C) 2000-2003, 2006, 2008-2020 Free Software Foundation, - Inc. + Copyright (C) 2000-2003, 2006, 2008-2020 Free Software Foundation, Inc. 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 diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index f660bba73b5..951220f3e29 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -1,6 +1,5 @@ /* c-strcasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index 89df6915840..9ad49191b7f 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -1,6 +1,5 @@ /* c-strncasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 197ce8de77f..1effdb78451 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -1,7 +1,7 @@ /* Read symbolic links into a buffer without size limitation, relative to fd. - Copyright (C) 2001, 2003-2004, 2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2001, 2003-2004, 2007, 2009-2020 Free Software Foundation, + Inc. 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 diff --git a/lib/cloexec.c b/lib/cloexec.c index 269e6f25f3b..510be3d57ec 100644 --- a/lib/cloexec.c +++ b/lib/cloexec.c @@ -1,7 +1,6 @@ /* cloexec.c - set or clear the close-on-exec descriptor flag - Copyright (C) 1991, 2004-2006, 2009-2020 Free Software Foundation, - Inc. + Copyright (C) 1991, 2004-2006, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/close-stream.c b/lib/close-stream.c index b1d04a53059..04bc8009a57 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -1,7 +1,6 @@ /* Close a stream, with nicer error checking than fclose's. - Copyright (C) 1998-2002, 2004, 2006-2020 Free Software Foundation, - Inc. + Copyright (C) 1998-2002, 2004, 2006-2020 Free Software Foundation, Inc. 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 diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 2b65cc9eda9..b548754e181 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -100,7 +100,6 @@ count_leading_zeros_l (unsigned long int x) COUNT_LEADING_ZEROS (__builtin_clzl, _BitScanReverse, unsigned long int); } -#if HAVE_UNSIGNED_LONG_LONG_INT /* Compute and return the number of leading zeros in X. */ COUNT_LEADING_ZEROS_INLINE int count_leading_zeros_ll (unsigned long long int x) @@ -108,7 +107,6 @@ count_leading_zeros_ll (unsigned long long int x) COUNT_LEADING_ZEROS (__builtin_clzll, _BitScanReverse64, unsigned long long int); } -#endif _GL_INLINE_HEADER_END diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h index 040776f7466..78770e4240d 100644 --- a/lib/count-one-bits.h +++ b/lib/count-one-bits.h @@ -122,14 +122,12 @@ count_one_bits_l (unsigned long int x) COUNT_ONE_BITS (__builtin_popcountl, __popcnt, unsigned long int); } -#if HAVE_UNSIGNED_LONG_LONG_INT /* Compute and return the number of 1-bits set in X. */ COUNT_ONE_BITS_INLINE int count_one_bits_ll (unsigned long long int x) { COUNT_ONE_BITS (__builtin_popcountll, __popcnt64, unsigned long long int); } -#endif _GL_INLINE_HEADER_END diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 15e85708d18..2169f626251 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -92,7 +92,6 @@ count_trailing_zeros_l (unsigned long int x) COUNT_TRAILING_ZEROS (__builtin_ctzl, _BitScanForward, unsigned long int); } -#if HAVE_UNSIGNED_LONG_LONG_INT /* Compute and return the number of trailing zeros in X. */ COUNT_TRAILING_ZEROS_INLINE int count_trailing_zeros_ll (unsigned long long int x) @@ -100,7 +99,6 @@ count_trailing_zeros_ll (unsigned long long int x) COUNT_TRAILING_ZEROS (__builtin_ctzll, _BitScanForward64, unsigned long long int); } -#endif _GL_INLINE_HEADER_END diff --git a/lib/diffseq.h b/lib/diffseq.h index 16e06053b43..c89363ac9ee 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -1,7 +1,7 @@ /* Analyze differences between two vectors. - Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2020 Free - Software Foundation, Inc. + Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2020 Free Software + Foundation, Inc. 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 diff --git a/lib/dosname.h b/lib/dosname.h index 3bb08a5eeec..57829600948 100644 --- a/lib/dosname.h +++ b/lib/dosname.h @@ -1,7 +1,6 @@ /* File names on MS-DOS/Windows systems. - Copyright (C) 2000-2001, 2004-2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2004-2006, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/dup2.c b/lib/dup2.c index b5c3a00c740..88ef2591313 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -1,7 +1,6 @@ /* Duplicate an open file descriptor to a specified file descriptor. - Copyright (C) 1999, 2004-2007, 2009-2020 Free Software Foundation, - Inc. + Copyright (C) 1999, 2004-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/filemode.h b/lib/filemode.h index 8b8464f220a..f84a491625c 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -1,7 +1,7 @@ /* Make a string describing file modes. - Copyright (C) 1998-1999, 2003, 2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2003, 2006, 2009-2020 Free Software Foundation, + Inc. 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 diff --git a/lib/fpending.c b/lib/fpending.c index 4db32eafd6a..802ebcba654 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -1,6 +1,6 @@ /* fpending.c -- return the number of pending output bytes on a stream - Copyright (C) 2000, 2004, 2006-2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2000, 2004, 2006-2007, 2009-2020 Free Software Foundation, + Inc. 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 diff --git a/lib/fpending.h b/lib/fpending.h index 52639379975..a8b8859726d 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -1,7 +1,7 @@ /* Declare __fpending. - Copyright (C) 2000, 2003, 2005-2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2000, 2003, 2005-2006, 2009-2020 Free Software Foundation, + Inc. 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 diff --git a/lib/fsusage.c b/lib/fsusage.c index c0ee4533f9a..81960152d41 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -1,7 +1,7 @@ /* fsusage.c -- return space usage of mounted file systems - Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2020 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2020 Free Software + Foundation, Inc. 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 diff --git a/lib/getgroups.c b/lib/getgroups.c index b1ec68dadf9..4396b4d64b7 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -1,7 +1,6 @@ /* provide consistent interface to getgroups for systems that don't allow N==0 - Copyright (C) 1996, 1999, 2003, 2006-2020 Free Software Foundation, - Inc. + Copyright (C) 1996, 1999, 2003, 2006-2020 Free Software Foundation, Inc. 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 diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 507017339cc..ebb6f5d5dba 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -1,7 +1,7 @@ /* Get the system load averages. - Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2020 Free - Software Foundation, Inc. + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2020 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. diff --git a/lib/gettext.h b/lib/gettext.h index 4c6b5efcc3f..0bd1e13348a 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -1,6 +1,6 @@ /* Convenience header for conditional use of GNU <libintl.h>. - Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2020 Free - Software Foundation, Inc. + Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2020 Free Software + Foundation, Inc. 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 diff --git a/lib/gettime.c b/lib/gettime.c index f212a238a88..f5b8ca53b5f 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -1,7 +1,6 @@ /* gettime -- get the system clock - Copyright (C) 2002, 2004-2007, 2009-2020 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index b5e2c300305..b63f8f29292 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -1,7 +1,6 @@ /* Provide gettimeofday for systems that don't have it or for which it's broken. - Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 5adea10c18e..6775db00015 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -127,7 +127,6 @@ # pipe2 \ # pselect \ # pthread_sigmask \ -# putenv \ # qcopy-acl \ # readlink \ # readlinkat \ @@ -316,6 +315,7 @@ GNULIB_GETLINE = @GNULIB_GETLINE@ GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@ GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ +GNULIB_GETOPT_POSIX = @GNULIB_GETOPT_POSIX@ GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ GNULIB_GETPASS = @GNULIB_GETPASS@ GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ @@ -580,7 +580,6 @@ HAVE_LCHMOD = @HAVE_LCHMOD@ HAVE_LCHOWN = @HAVE_LCHOWN@ HAVE_LINK = @HAVE_LINK@ HAVE_LINKAT = @HAVE_LINKAT@ -HAVE_LONG_LONG_INT = @HAVE_LONG_LONG_INT@ HAVE_LSTAT = @HAVE_LSTAT@ HAVE_MAKEINFO = @HAVE_MAKEINFO@ HAVE_MAX_ALIGN_T = @HAVE_MAX_ALIGN_T@ @@ -676,7 +675,6 @@ HAVE_TZSET = @HAVE_TZSET@ HAVE_UNISTD_H = @HAVE_UNISTD_H@ HAVE_UNLINKAT = @HAVE_UNLINKAT@ HAVE_UNLOCKPT = @HAVE_UNLOCKPT@ -HAVE_UNSIGNED_LONG_LONG_INT = @HAVE_UNSIGNED_LONG_LONG_INT@ HAVE_USLEEP = @HAVE_USLEEP@ HAVE_UTIMENSAT = @HAVE_UTIMENSAT@ HAVE_VASPRINTF = @HAVE_VASPRINTF@ @@ -768,6 +766,7 @@ MAKEINFO = @MAKEINFO@ MAKE_PROG = @MAKE_PROG@ MKDIR_P = @MKDIR_P@ MODULES_OBJ = @MODULES_OBJ@ +MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@ MODULES_SUFFIX = @MODULES_SUFFIX@ NEXT_AS_FIRST_DIRECTIVE_DIRENT_H = @NEXT_AS_FIRST_DIRECTIVE_DIRENT_H@ NEXT_AS_FIRST_DIRECTIVE_ERRNO_H = @NEXT_AS_FIRST_DIRECTIVE_ERRNO_H@ @@ -855,6 +854,7 @@ REPLACE_DPRINTF = @REPLACE_DPRINTF@ REPLACE_DUP = @REPLACE_DUP@ REPLACE_DUP2 = @REPLACE_DUP2@ REPLACE_FACCESSAT = @REPLACE_FACCESSAT@ +REPLACE_FCHMODAT = @REPLACE_FCHMODAT@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ REPLACE_FCLOSE = @REPLACE_FCLOSE@ REPLACE_FCNTL = @REPLACE_FCNTL@ @@ -886,6 +886,7 @@ REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@ REPLACE_GMTIME = @REPLACE_GMTIME@ REPLACE_INITSTATE = @REPLACE_INITSTATE@ REPLACE_ISATTY = @REPLACE_ISATTY@ +REPLACE_LCHMOD = @REPLACE_LCHMOD@ REPLACE_LCHOWN = @REPLACE_LCHOWN@ REPLACE_LINK = @REPLACE_LINK@ REPLACE_LINKAT = @REPLACE_LINKAT@ @@ -1198,12 +1199,9 @@ endif ifeq (,$(OMIT_GNULIB_MODULE_at-internal)) ifneq (,$(gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b)) +libgnu_a_SOURCES += openat-priv.h openat-proc.c endif -EXTRA_DIST += openat-priv.h openat-proc.c - -EXTRA_libgnu_a_SOURCES += openat-proc.c - endif ## end gnulib module at-internal @@ -1910,8 +1908,6 @@ inttypes.h: inttypes.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(WARN_ON_U -e 's|@''NEXT_INTTYPES_H''@|$(NEXT_INTTYPES_H)|g' \ -e 's/@''PRI_MACROS_BROKEN''@/$(PRI_MACROS_BROKEN)/g' \ -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ - -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ - -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ -e 's/@''PRIPTR_PREFIX''@/$(PRIPTR_PREFIX)/g' \ -e 's/@''GNULIB_IMAXABS''@/$(GNULIB_IMAXABS)/g' \ -e 's/@''GNULIB_IMAXDIV''@/$(GNULIB_IMAXDIV)/g' \ @@ -2167,17 +2163,6 @@ EXTRA_libgnu_a_SOURCES += pthread_sigmask.c endif ## end gnulib module pthread_sigmask -## begin gnulib module putenv -ifeq (,$(OMIT_GNULIB_MODULE_putenv)) - - -EXTRA_DIST += putenv.c - -EXTRA_libgnu_a_SOURCES += putenv.c - -endif -## end gnulib module putenv - ## begin gnulib module qcopy-acl ifeq (,$(OMIT_GNULIB_MODULE_qcopy-acl)) @@ -2432,8 +2417,6 @@ stdint.h: stdint.in.h $(top_builddir)/config.status -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ - -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ - -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ @@ -2954,9 +2937,11 @@ sys/stat.h: sys_stat.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNU -e 's|@''HAVE_MKNOD''@|$(HAVE_MKNOD)|g' \ -e 's|@''HAVE_MKNODAT''@|$(HAVE_MKNODAT)|g' \ -e 's|@''HAVE_UTIMENSAT''@|$(HAVE_UTIMENSAT)|g' \ + -e 's|@''REPLACE_FCHMODAT''@|$(REPLACE_FCHMODAT)|g' \ -e 's|@''REPLACE_FSTAT''@|$(REPLACE_FSTAT)|g' \ -e 's|@''REPLACE_FSTATAT''@|$(REPLACE_FSTATAT)|g' \ -e 's|@''REPLACE_FUTIMENS''@|$(REPLACE_FUTIMENS)|g' \ + -e 's|@''REPLACE_LCHMOD''@|$(REPLACE_LCHMOD)|g' \ -e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \ -e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \ -e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \ @@ -3218,6 +3203,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_GETHOSTNAME''@/$(GNULIB_GETHOSTNAME)/g' \ -e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \ -e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \ + -e 's/@''GNULIB_GETOPT_POSIX''@/$(GNULIB_GETOPT_POSIX)/g' \ -e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \ -e 's/@''GNULIB_GETPASS''@/$(GNULIB_GETPASS)/g' \ -e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \ diff --git a/lib/group-member.c b/lib/group-member.c index 7aa8a453615..6a6fc5605ef 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -1,7 +1,7 @@ /* group-member.c -- determine whether group id is in calling user's group list - Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2020 Free - Software Foundation, Inc. + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2020 Free Software + Foundation, Inc. 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 diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h index da84aff0440..d6efc7eeeef 100644 --- a/lib/inttypes.in.h +++ b/lib/inttypes.in.h @@ -38,6 +38,8 @@ # endif # @INCLUDE_NEXT@ @NEXT_INTTYPES_H@ + +# define _GL_FINISHED_INCLUDING_SYSTEM_INTTYPES_H # endif #endif @@ -189,7 +191,7 @@ # define _PRI64_PREFIX "l" # elif defined _MSC_VER || defined __MINGW32__ # define _PRI64_PREFIX "I64" -# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +# elif LONG_MAX >> 30 == 1 # define _PRI64_PREFIX _LONG_LONG_FORMAT_PREFIX # endif # if !defined PRId64 || @PRI_MACROS_BROKEN@ @@ -206,7 +208,7 @@ # define _PRIu64_PREFIX "l" # elif defined _MSC_VER || defined __MINGW32__ # define _PRIu64_PREFIX "I64" -# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +# elif ULONG_MAX >> 31 == 1 # define _PRIu64_PREFIX _LONG_LONG_FORMAT_PREFIX # endif # if !defined PRIo64 || @PRI_MACROS_BROKEN@ @@ -682,7 +684,7 @@ # define _SCN64_PREFIX "l" # elif defined _MSC_VER || defined __MINGW32__ # define _SCN64_PREFIX "I64" -# elif @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +# elif LONG_MAX >> 30 == 1 # define _SCN64_PREFIX _LONG_LONG_FORMAT_PREFIX # endif # if !defined SCNd64 || @PRI_MACROS_BROKEN@ @@ -699,7 +701,7 @@ # define _SCNu64_PREFIX "l" # elif defined _MSC_VER || defined __MINGW32__ # define _SCNu64_PREFIX "I64" -# elif @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +# elif ULONG_MAX >> 31 == 1 # define _SCNu64_PREFIX _LONG_LONG_FORMAT_PREFIX # endif # if !defined SCNo64 || @PRI_MACROS_BROKEN@ diff --git a/lib/libc-config.h b/lib/libc-config.h index aef1f793242..124f1d77e01 100644 --- a/lib/libc-config.h +++ b/lib/libc-config.h @@ -55,8 +55,17 @@ #ifndef __glibc_clang_prereq # if defined __clang_major__ && defined __clang_minor__ -# define __glibc_clang_prereq(maj, min) \ - ((maj) < __clang_major__ + ((min) <= __clang_minor__)) +# ifdef __apple_build_version__ +/* Apple for some reason renumbers __clang_major__ and __clang_minor__. + Gnulib code uses only __glibc_clang_prereq (3, 5); map it to + 6000000 <= __apple_build_version__. Support for other calls to + __glibc_clang_prereq can be added here as needed. */ +# define __glibc_clang_prereq(maj, min) \ + ((maj) == 3 && (min) == 5 ? 6000000 <= __apple_build_version__ : 0) +# else +# define __glibc_clang_prereq(maj, min) \ + ((maj) < __clang_major__ + ((min) <= __clang_minor__)) +# endif # else # define __glibc_clang_prereq(maj, min) 0 # endif diff --git a/lib/localtime-buffer.c b/lib/localtime-buffer.c index eb099ff8d84..141849c5461 100644 --- a/lib/localtime-buffer.c +++ b/lib/localtime-buffer.c @@ -1,7 +1,6 @@ /* Provide access to the last buffer returned by localtime() or gmtime(). - Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/localtime-buffer.h b/lib/localtime-buffer.h index 2552cfcffba..3801742f7ba 100644 --- a/lib/localtime-buffer.h +++ b/lib/localtime-buffer.h @@ -1,7 +1,6 @@ /* Provide access to the last buffer returned by localtime() or gmtime(). - Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/malloca.c b/lib/malloca.c index 59bd74d598b..975b166daed 100644 --- a/lib/malloca.c +++ b/lib/malloca.c @@ -1,6 +1,5 @@ /* Safe automatic memory allocation. - Copyright (C) 2003, 2006-2007, 2009-2020 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2009-2020 Free Software Foundation, Inc. Written by Bruno Haible <bruno@clisp.org>, 2003, 2018. This program is free software; you can redistribute it and/or modify diff --git a/lib/malloca.h b/lib/malloca.h index 0d0b713c7bd..cfcd4de4ad8 100644 --- a/lib/malloca.h +++ b/lib/malloca.h @@ -112,14 +112,10 @@ enum among all elementary types. */ sa_alignment_long = sa_alignof (long), sa_alignment_double = sa_alignof (double), -#if HAVE_LONG_LONG_INT sa_alignment_longlong = sa_alignof (long long), -#endif sa_alignment_longdouble = sa_alignof (long double), sa_alignment_max = ((sa_alignment_long - 1) | (sa_alignment_double - 1) -#if HAVE_LONG_LONG_INT | (sa_alignment_longlong - 1) -#endif | (sa_alignment_longdouble - 1) ) + 1 }; diff --git a/lib/md5.c b/lib/md5.c index e0f3032aec0..74cf2c3a0f7 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2020 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2020 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify it diff --git a/lib/md5.h b/lib/md5.h index 7c827b0586a..239748ae0cb 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -1,7 +1,7 @@ /* Declaration of functions and data types used for MD5 sum computing library functions. - Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2020 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2020 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify it diff --git a/lib/memmem.c b/lib/memmem.c index 9108f6f697c..6f6574211f8 100644 --- a/lib/memmem.c +++ b/lib/memmem.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2020 Free - Software Foundation, Inc. +/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2020 Free Software + Foundation, Inc. This file is part of the GNU C Library. This program is free software; you can redistribute it and/or modify diff --git a/lib/memrchr.c b/lib/memrchr.c index b4256edcbb9..7ff32e11338 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -1,7 +1,7 @@ /* memrchr -- find the last occurrence of a byte in a memory block - Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2020 Free - Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2020 Free Software + Foundation, Inc. Based on strlen implementation by Torbjorn Granlund (tege@sics.se), with help from Dan Sahlin (dan@sics.se) and diff --git a/lib/mktime.c b/lib/mktime.c index a13fa27e2bc..92c00b2b14b 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -141,7 +141,7 @@ shr (long_int a, int b) long_int one = 1; return (-one >> 1 == -1 ? a >> b - : a / (one << b) - (a % (one << b) < 0)); + : (a + (a < 0)) / (one << b) - (a < 0)); } /* Bounds for the intersection of __time64_t and long_int. */ @@ -211,8 +211,8 @@ ydhms_diff (long_int year1, long_int yday1, int hour1, int min1, int sec1, Take care to avoid integer overflow here. */ int a4 = shr (year1, 2) + shr (TM_YEAR_BASE, 2) - ! (year1 & 3); int b4 = shr (year0, 2) + shr (TM_YEAR_BASE, 2) - ! (year0 & 3); - int a100 = a4 / 25 - (a4 % 25 < 0); - int b100 = b4 / 25 - (b4 % 25 < 0); + int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); + int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); int a400 = shr (a100, 2); int b400 = shr (b100, 2); int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 667c7ddc56e..fc5052a549c 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -113,7 +113,7 @@ extern char *tzname[]; #define SHR(a, b) \ (-1 >> 1 == -1 \ ? (a) >> (b) \ - : (a) / (1 << (b)) - ((a) % (1 << (b)) < 0)) + : ((a) + ((a) < 0)) / (1 << (b)) - ((a) < 0)) #define TM_YEAR_BASE 1900 @@ -348,8 +348,8 @@ tm_diff (const struct tm *a, const struct tm *b) but it's OK to assume that A and B are close to each other. */ int a4 = SHR (a->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (a->tm_year & 3); int b4 = SHR (b->tm_year, 2) + SHR (TM_YEAR_BASE, 2) - ! (b->tm_year & 3); - int a100 = a4 / 25 - (a4 % 25 < 0); - int b100 = b4 / 25 - (b4 % 25 < 0); + int a100 = (a4 + (a4 < 0)) / 25 - (a4 < 0); + int b100 = (b4 + (b4 < 0)) / 25 - (b4 < 0); int a400 = SHR (a100, 2); int b400 = SHR (b100, 2); int intervening_leap_days = (a4 - b4) - (a100 - b100) + (a400 - b400); @@ -927,9 +927,11 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) } { - int century = tp->tm_year / 100 + TM_YEAR_BASE / 100; - century -= tp->tm_year % 100 < 0 && 0 < century; - DO_YEARISH (2, tp->tm_year < - TM_YEAR_BASE, century); + bool negative_year = tp->tm_year < - TM_YEAR_BASE; + bool zero_thru_1899 = !negative_year & (tp->tm_year < 0); + int century = ((tp->tm_year - 99 * zero_thru_1899) / 100 + + TM_YEAR_BASE / 100); + DO_YEARISH (2, negative_year, century); } case L_('x'): @@ -1138,8 +1140,8 @@ __strftime_internal (STREAM_OR_CHAR_T *s, STRFTIME_ARG (size_t maxsize) int ndigs = ns_digits; while (width < ndigs || (1 < ndigs && n % 10 == 0)) ndigs--, n /= 10; - for (int i = ndigs; 0 < i; i--) - buf[i - 1] = n % 10 + L_('0'), n /= 10; + for (int j = ndigs; 0 < j; j--) + buf[j - 1] = n % 10 + L_('0'), n /= 10; if (!pad) pad = L_('0'); width_cpy (0, ndigs, buf); diff --git a/lib/putenv.c b/lib/putenv.c deleted file mode 100644 index 9e862e63d3d..00000000000 --- a/lib/putenv.c +++ /dev/null @@ -1,194 +0,0 @@ -/* Copyright (C) 1991, 1994, 1997-1998, 2000, 2003-2020 Free Software - Foundation, Inc. - - NOTE: The canonical source of this file is maintained with the GNU C - Library. Bugs can be reported to bug-glibc@prep.ai.mit.edu. - - 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 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 <https://www.gnu.org/licenses/>. */ - -#include <config.h> - -/* Specification. */ -#include <stdlib.h> - -#include <stddef.h> - -/* Include errno.h *after* sys/types.h to work around header problems - on AIX 3.2.5. */ -#include <errno.h> -#ifndef __set_errno -# define __set_errno(ev) ((errno) = (ev)) -#endif - -#include <string.h> -#include <unistd.h> - -#if defined _WIN32 && ! defined __CYGWIN__ -# define WIN32_LEAN_AND_MEAN -# include <windows.h> -#endif - -#if _LIBC -# if HAVE_GNU_LD -# define environ __environ -# else -extern char **environ; -# endif -#endif - -#if _LIBC -/* This lock protects against simultaneous modifications of 'environ'. */ -# include <bits/libc-lock.h> -__libc_lock_define_initialized (static, envlock) -# define LOCK __libc_lock_lock (envlock) -# define UNLOCK __libc_lock_unlock (envlock) -#else -# define LOCK -# define UNLOCK -#endif - -static int -_unsetenv (const char *name) -{ - size_t len; -#if !HAVE_DECL__PUTENV - char **ep; -#endif - - if (name == NULL || *name == '\0' || strchr (name, '=') != NULL) - { - __set_errno (EINVAL); - return -1; - } - - len = strlen (name); - -#if HAVE_DECL__PUTENV - { - int putenv_result, putenv_errno; - char *name_ = malloc (len + 2); - memcpy (name_, name, len); - name_[len] = '='; - name_[len + 1] = 0; - putenv_result = _putenv (name_); - putenv_errno = errno; - free (name_); - __set_errno (putenv_errno); - return putenv_result; - } -#else - - LOCK; - - ep = environ; - while (*ep != NULL) - if (!strncmp (*ep, name, len) && (*ep)[len] == '=') - { - /* Found it. Remove this pointer by moving later ones back. */ - char **dp = ep; - - do - dp[0] = dp[1]; - while (*dp++); - /* Continue the loop in case NAME appears again. */ - } - else - ++ep; - - UNLOCK; - - return 0; -#endif -} - - -/* Put STRING, which is of the form "NAME=VALUE", in the environment. - If STRING contains no '=', then remove STRING from the environment. */ -int -putenv (char *string) -{ - const char *name_end = strchr (string, '='); - char **ep; - - if (name_end == NULL) - { - /* Remove the variable from the environment. */ - return _unsetenv (string); - } - -#if HAVE_DECL__PUTENV - /* Rely on _putenv to allocate the new environment. If other - parts of the application use _putenv, the !HAVE_DECL__PUTENV code - would fight over who owns the environ vector, causing a crash. */ - if (name_end[1]) - return _putenv (string); - else - { - /* _putenv ("NAME=") unsets NAME, so invoke _putenv ("NAME= ") - to allocate the environ vector and then replace the new - entry with "NAME=". */ - int putenv_result, putenv_errno; - char *name_x = malloc (name_end - string + sizeof "= "); - if (!name_x) - return -1; - memcpy (name_x, string, name_end - string + 1); - name_x[name_end - string + 1] = ' '; - name_x[name_end - string + 2] = 0; - putenv_result = _putenv (name_x); - putenv_errno = errno; - for (ep = environ; *ep; ep++) - if (strcmp (*ep, name_x) == 0) - { - *ep = string; - break; - } -# if defined _WIN32 && ! defined __CYGWIN__ - if (putenv_result == 0) - { - /* _putenv propagated "NAME= " into the subprocess environment; - fix that by calling SetEnvironmentVariable directly. */ - name_x[name_end - string] = 0; - putenv_result = SetEnvironmentVariable (name_x, "") ? 0 : -1; - putenv_errno = ENOMEM; /* ENOMEM is the only way to fail. */ - } -# endif - free (name_x); - __set_errno (putenv_errno); - return putenv_result; - } -#else - for (ep = environ; *ep; ep++) - if (strncmp (*ep, string, name_end - string) == 0 - && (*ep)[name_end - string] == '=') - break; - - if (*ep) - *ep = string; - else - { - static char **last_environ = NULL; - size_t size = ep - environ; - char **new_environ = malloc ((size + 2) * sizeof *new_environ); - if (! new_environ) - return -1; - new_environ[0] = string; - memcpy (new_environ + 1, environ, (size + 1) * sizeof *new_environ); - free (last_environ); - last_environ = new_environ; - environ = new_environ; - } - - return 0; -#endif -} diff --git a/lib/regex.c b/lib/regex.c index 6bdd77f50b2..88173bb1052 100644 --- a/lib/regex.c +++ b/lib/regex.c @@ -17,6 +17,8 @@ License along with the GNU C Library; if not, see <https://www.gnu.org/licenses/>. */ +#define __STDC_WANT_IEC_60559_BFP_EXT__ + #ifndef _LIBC # include <libc-config.h> diff --git a/lib/regex_internal.h b/lib/regex_internal.h index 5c9cbf3b4fe..f6ebfb003e8 100644 --- a/lib/regex_internal.h +++ b/lib/regex_internal.h @@ -141,6 +141,24 @@ #ifndef SSIZE_MAX # define SSIZE_MAX ((ssize_t) (SIZE_MAX / 2)) #endif +#ifndef ULONG_WIDTH +# define ULONG_WIDTH REGEX_UINTEGER_WIDTH (ULONG_MAX) +/* The number of usable bits in an unsigned integer type with maximum + value MAX, as an int expression suitable in #if. Cover all known + practical hosts. This implementation exploits the fact that MAX is + 1 less than a power of 2, and merely counts the number of 1 bits in + MAX; "COBn" means "count the number of 1 bits in the low-order n bits". */ +# define REGEX_UINTEGER_WIDTH(max) REGEX_COB128 (max) +# define REGEX_COB128(n) (REGEX_COB64 ((n) >> 31 >> 31 >> 2) + REGEX_COB64 (n)) +# define REGEX_COB64(n) (REGEX_COB32 ((n) >> 31 >> 1) + REGEX_COB32 (n)) +# define REGEX_COB32(n) (REGEX_COB16 ((n) >> 16) + REGEX_COB16 (n)) +# define REGEX_COB16(n) (REGEX_COB8 ((n) >> 8) + REGEX_COB8 (n)) +# define REGEX_COB8(n) (REGEX_COB4 ((n) >> 4) + REGEX_COB4 (n)) +# define REGEX_COB4(n) (!!((n) & 8) + !!((n) & 4) + !!((n) & 2) + ((n) & 1)) +# if ULONG_MAX / 2 + 1 != 1ul << (ULONG_WIDTH - 1) +# error "ULONG_MAX out of range" +# endif +#endif /* The type of indexes into strings. This is signed, not size_t, since the API requires indexes to fit in regoff_t anyway, and using @@ -164,36 +182,8 @@ typedef __re_size_t re_hashval_t; typedef unsigned long int bitset_word_t; /* All bits set in a bitset_word_t. */ #define BITSET_WORD_MAX ULONG_MAX - -/* Number of bits in a bitset_word_t. For portability to hosts with - padding bits, do not use '(sizeof (bitset_word_t) * CHAR_BIT)'; - instead, deduce it directly from BITSET_WORD_MAX. Avoid - greater-than-32-bit integers and unconditional shifts by more than - 31 bits, as they're not portable. */ -#if BITSET_WORD_MAX == 0xffffffffUL -# define BITSET_WORD_BITS 32 -#elif BITSET_WORD_MAX >> 31 >> 4 == 1 -# define BITSET_WORD_BITS 36 -#elif BITSET_WORD_MAX >> 31 >> 16 == 1 -# define BITSET_WORD_BITS 48 -#elif BITSET_WORD_MAX >> 31 >> 28 == 1 -# define BITSET_WORD_BITS 60 -#elif BITSET_WORD_MAX >> 31 >> 31 >> 1 == 1 -# define BITSET_WORD_BITS 64 -#elif BITSET_WORD_MAX >> 31 >> 31 >> 9 == 1 -# define BITSET_WORD_BITS 72 -#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 3 == 1 -# define BITSET_WORD_BITS 128 -#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 == 1 -# define BITSET_WORD_BITS 256 -#elif BITSET_WORD_MAX >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 31 >> 7 > 1 -# define BITSET_WORD_BITS 257 /* any value > SBC_MAX will do here */ -# if BITSET_WORD_BITS <= SBC_MAX -# error "Invalid SBC_MAX" -# endif -#else -# error "Add case for new bitset_word_t size" -#endif +/* Number of bits in a bitset_word_t. */ +#define BITSET_WORD_BITS ULONG_WIDTH /* Number of bitset_word_t values in a bitset_t. */ #define BITSET_WORDS ((SBC_MAX + BITSET_WORD_BITS - 1) / BITSET_WORD_BITS) @@ -601,9 +591,8 @@ struct re_backref_cache_entry Idx str_idx; Idx subexp_from; Idx subexp_to; + bitset_word_t eps_reachable_subexps_map; char more; - char unused; - unsigned short int eps_reachable_subexps_map; }; typedef struct diff --git a/lib/sha1.c b/lib/sha1.c index 68e74ff3f98..bacf29c4051 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -1,8 +1,7 @@ /* sha1.c - Functions to compute SHA1 message digest of files or memory blocks according to the NIST specification FIPS-180-1. - Copyright (C) 2000-2001, 2003-2006, 2008-2020 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2003-2006, 2008-2020 Free Software Foundation, Inc. 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 diff --git a/lib/sig2str.c b/lib/sig2str.c index 47c6cfcf95e..905daea2f20 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -1,7 +1,6 @@ /* sig2str.c -- convert between signal names and numbers - Copyright (C) 2002, 2004, 2006, 2009-2020 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004, 2006, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/signal.in.h b/lib/signal.in.h index 42e1897f1ea..9fe9f605c3a 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -322,6 +322,12 @@ _GL_FUNCDECL_RPL (signal, _gl_function_taking_int_returning_void_t, _GL_CXXALIAS_RPL (signal, _gl_function_taking_int_returning_void_t, (int sig, _gl_function_taking_int_returning_void_t func)); # else +/* On OpenBSD, the declaration of 'signal' may not be present at this point, + because it occurs in <sys/signal.h>, not <signal.h> directly. */ +# if defined __OpenBSD__ +_GL_FUNCDECL_SYS (signal, _gl_function_taking_int_returning_void_t, + (int sig, _gl_function_taking_int_returning_void_t func)); +# endif _GL_CXXALIAS_SYS (signal, _gl_function_taking_int_returning_void_t, (int sig, _gl_function_taking_int_returning_void_t func)); # endif diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index 2f53411e16c..cd786bed2cd 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -102,7 +102,7 @@ # define _Alignas(a) alignas (a) # elif ((defined __APPLE__ && defined __MACH__ \ ? 4 < __GNUC__ + (1 <= __GNUC_MINOR__) \ - : __GNUC__) \ + : __GNUC__ && !defined __ibmxl__) \ || (__ia64 && (61200 <= __HP_cc || 61200 <= __HP_aCC)) \ || __ICC || 0x590 <= __SUNPRO_C || 0x0600 <= __xlC__) # define _Alignas(a) __attribute__ ((__aligned__ (a))) diff --git a/lib/stddef.in.h b/lib/stddef.in.h index e146063c026..2e50a1f01e8 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -83,20 +83,26 @@ /* Some platforms lack max_align_t. The check for _GCC_MAX_ALIGN_T is a hack in case the configure-time test was done with g++ even though - we are currently compiling with gcc. */ -#if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T) -# if !GNULIB_defined_max_align_t + we are currently compiling with gcc. + On MSVC, max_align_t is defined only in C++ mode, after <cstddef> was + included. Its definition is good since it has an alignment of 8 (on x86 + and x86_64). */ +#if defined _MSC_VER && defined __cplusplus +# include <cstddef> +#else +# if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T) +# if !GNULIB_defined_max_align_t /* On the x86, the maximum storage alignment of double, long, etc. is 4, but GCC's C11 ABI for x86 says that max_align_t has an alignment of 8, and the C11 standard allows this. Work around this problem by using __alignof__ (which returns 8 for double) rather than _Alignof (which returns 4), and align each union member accordingly. */ -# ifdef __GNUC__ -# define _GL_STDDEF_ALIGNAS(type) \ - __attribute__ ((__aligned__ (__alignof__ (type)))) -# else -# define _GL_STDDEF_ALIGNAS(type) /* */ -# endif +# ifdef __GNUC__ +# define _GL_STDDEF_ALIGNAS(type) \ + __attribute__ ((__aligned__ (__alignof__ (type)))) +# else +# define _GL_STDDEF_ALIGNAS(type) /* */ +# endif typedef union { char *__p _GL_STDDEF_ALIGNAS (char *); @@ -104,8 +110,9 @@ typedef union long double __ld _GL_STDDEF_ALIGNAS (long double); long int __i _GL_STDDEF_ALIGNAS (long int); } rpl_max_align_t; -# define max_align_t rpl_max_align_t -# define GNULIB_defined_max_align_t 1 +# define max_align_t rpl_max_align_t +# define GNULIB_defined_max_align_t 1 +# endif # endif #endif diff --git a/lib/stdint.in.h b/lib/stdint.in.h index a83bc45c79c..994c0c777c0 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -188,7 +188,7 @@ typedef long int gl_int64_t; typedef __int64 gl_int64_t; # define int64_t gl_int64_t # define GL_INT64_T -# elif @HAVE_LONG_LONG_INT@ +# else # undef int64_t typedef long long int gl_int64_t; # define int64_t gl_int64_t @@ -209,7 +209,7 @@ typedef unsigned long int gl_uint64_t; typedef unsigned __int64 gl_uint64_t; # define uint64_t gl_uint64_t # define GL_UINT64_T -# elif @HAVE_UNSIGNED_LONG_LONG_INT@ +# else # undef uint64_t typedef unsigned long long int gl_uint64_t; # define uint64_t gl_uint64_t @@ -333,7 +333,7 @@ typedef unsigned long int gl_uintptr_t; # ifndef INTMAX_MAX # undef INTMAX_C # undef intmax_t -# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +# if LONG_MAX >> 30 == 1 typedef long long int gl_intmax_t; # define intmax_t gl_intmax_t # elif defined GL_INT64_T @@ -347,7 +347,7 @@ typedef long int gl_intmax_t; # ifndef UINTMAX_MAX # undef UINTMAX_C # undef uintmax_t -# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +# if ULONG_MAX >> 31 == 1 typedef unsigned long long int gl_uintmax_t; # define uintmax_t gl_uintmax_t # elif defined GL_UINT64_T @@ -647,21 +647,21 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t) # define INT64_C(x) x##L # elif defined _MSC_VER # define INT64_C(x) x##i64 -# elif @HAVE_LONG_LONG_INT@ +# else # define INT64_C(x) x##LL # endif # if ULONG_MAX >> 31 >> 31 >> 1 == 1 # define UINT64_C(x) x##UL # elif defined _MSC_VER # define UINT64_C(x) x##ui64 -# elif @HAVE_UNSIGNED_LONG_LONG_INT@ +# else # define UINT64_C(x) x##ULL # endif /* 7.18.4.2. Macros for greatest-width integer constants */ # ifndef INTMAX_C -# if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +# if LONG_MAX >> 30 == 1 # define INTMAX_C(x) x##LL # elif defined GL_INT64_T # define INTMAX_C(x) INT64_C(x) @@ -671,7 +671,7 @@ typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t) # endif # ifndef UINTMAX_C -# if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +# if ULONG_MAX >> 31 == 1 # define UINTMAX_C(x) x##ULL # elif defined GL_UINT64_T # define UINTMAX_C(x) UINT64_C(x) diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 6dc526eaab0..ebcbfaf5e77 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -1259,7 +1259,9 @@ _GL_FUNCDECL_SYS (vdprintf, int, (int fd, const char *format, va_list args) _GL_CXXALIAS_SYS_CAST (vdprintf, int, (int fd, const char *format, va_list args)); # endif +# if __GLIBC__ >= 2 _GL_CXXALIASWARN (vdprintf); +# endif #elif defined GNULIB_POSIXCHECK # undef vdprintf # if HAVE_RAW_DECL_VDPRINTF diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 1524277d799..49bbf6fccfb 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -1,7 +1,6 @@ /* A GNU-like <stdlib.h>. - Copyright (C) 1995, 2001-2004, 2006-2020 Free Software Foundation, - Inc. + Copyright (C) 1995, 2001-2004, 2006-2020 Free Software Foundation, Inc. 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 @@ -202,6 +201,10 @@ _GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name) # endif _GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name)); # endif +# ifndef GNULIB_defined_canonicalize_file_name +# define GNULIB_defined_canonicalize_file_name \ + (!@HAVE_CANONICALIZE_FILE_NAME@ || @REPLACE_CANONICALIZE_FILE_NAME@) +# endif _GL_CXXALIASWARN (canonicalize_file_name); #elif defined GNULIB_POSIXCHECK # undef canonicalize_file_name @@ -517,6 +520,9 @@ _GL_FUNCDECL_SYS (ptsname_r, int, (int fd, char *buf, size_t len)); # endif _GL_CXXALIAS_SYS (ptsname_r, int, (int fd, char *buf, size_t len)); # endif +# ifndef GNULIB_defined_ptsname_r +# define GNULIB_defined_ptsname_r (!@HAVE_PTSNAME_R@ || @REPLACE_PTSNAME_R@) +# endif _GL_CXXALIASWARN (ptsname_r); #elif defined GNULIB_POSIXCHECK # undef ptsname_r @@ -600,7 +606,9 @@ _GL_CXXALIAS_RPL (random, long, (void)); # if !@HAVE_RANDOM@ _GL_FUNCDECL_SYS (random, long, (void)); # endif -_GL_CXXALIAS_SYS (random, long, (void)); +/* Need to cast, because on Haiku, the return type is + int. */ +_GL_CXXALIAS_SYS_CAST (random, long, (void)); # endif _GL_CXXALIASWARN (random); #elif defined GNULIB_POSIXCHECK @@ -767,9 +775,11 @@ _GL_FUNCDECL_SYS (initstate_r, int, struct random_data *rand_state) _GL_ARG_NONNULL ((2, 4))); # endif -_GL_CXXALIAS_SYS (initstate_r, int, - (unsigned int seed, char *buf, size_t buf_size, - struct random_data *rand_state)); +/* Need to cast, because on Haiku, the third parameter is + unsigned long buf_size. */ +_GL_CXXALIAS_SYS_CAST (initstate_r, int, + (unsigned int seed, char *buf, size_t buf_size, + struct random_data *rand_state)); # endif _GL_CXXALIASWARN (initstate_r); #elif defined GNULIB_POSIXCHECK @@ -797,8 +807,10 @@ _GL_FUNCDECL_SYS (setstate_r, int, (char *arg_state, struct random_data *rand_state) _GL_ARG_NONNULL ((1, 2))); # endif -_GL_CXXALIAS_SYS (setstate_r, int, - (char *arg_state, struct random_data *rand_state)); +/* Need to cast, because on Haiku, the first parameter is + void *arg_state. */ +_GL_CXXALIAS_SYS_CAST (setstate_r, int, + (char *arg_state, struct random_data *rand_state)); # endif _GL_CXXALIASWARN (setstate_r); #elif defined GNULIB_POSIXCHECK diff --git a/lib/strtoimax.c b/lib/strtoimax.c index 95f6f3ff11f..a17b2f0a9d7 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an intmax_t value. - Copyright (C) 1999, 2001-2004, 2006, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2004, 2006, 2009-2020 Free Software Foundation, + Inc. 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 @@ -28,36 +28,30 @@ #include "verify.h" #ifdef UNSIGNED -# if HAVE_UNSIGNED_LONG_LONG_INT -# ifndef HAVE_DECL_STRTOULL +# ifndef HAVE_DECL_STRTOULL "this configure-time declaration test was not run" -# endif -# if !HAVE_DECL_STRTOULL +# endif +# if !HAVE_DECL_STRTOULL unsigned long long int strtoull (char const *, char **, int); -# endif # endif #else -# if HAVE_LONG_LONG_INT -# ifndef HAVE_DECL_STRTOLL +# ifndef HAVE_DECL_STRTOLL "this configure-time declaration test was not run" -# endif -# if !HAVE_DECL_STRTOLL +# endif +# if !HAVE_DECL_STRTOLL long long int strtoll (char const *, char **, int); -# endif # endif #endif #ifdef UNSIGNED -# define Have_long_long HAVE_UNSIGNED_LONG_LONG_INT # define Int uintmax_t # define Strtoimax strtoumax # define Strtol strtoul # define Strtoll strtoull # define Unsigned unsigned #else -# define Have_long_long HAVE_LONG_LONG_INT # define Int intmax_t # define Strtoimax strtoimax # define Strtol strtol @@ -68,15 +62,11 @@ long long int strtoll (char const *, char **, int); Int Strtoimax (char const *ptr, char **endptr, int base) { -#if Have_long_long verify (sizeof (Int) == sizeof (Unsigned long int) || sizeof (Int) == sizeof (Unsigned long long int)); if (sizeof (Int) != sizeof (Unsigned long int)) return Strtoll (ptr, endptr, base); -#else - verify (sizeof (Int) == sizeof (Unsigned long int)); -#endif return Strtol (ptr, endptr, base); } diff --git a/lib/strtol.c b/lib/strtol.c index a2e1dee99ee..02aafca44ea 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an integer value. - Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2020 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2020 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/strtoll.c b/lib/strtoll.c index 0b8e03c025c..3c7e8c002f0 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -1,6 +1,6 @@ /* Function to parse a 'long long int' from text. - Copyright (C) 1995-1997, 1999, 2001, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1995-1997, 1999, 2001, 2009-2020 Free Software Foundation, + Inc. This file is part of the GNU C Library. This program is free software: you can redistribute it and/or modify diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index c1e3243c1fe..e3ab3153fbf 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -392,13 +392,25 @@ struct stat #if @GNULIB_FCHMODAT@ -# if !@HAVE_FCHMODAT@ +# if @REPLACE_FCHMODAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fchmodat +# define fchmodat rpl_fchmodat +# endif +_GL_FUNCDECL_RPL (fchmodat, int, + (int fd, char const *file, mode_t mode, int flag) + _GL_ARG_NONNULL ((2))); +_GL_CXXALIAS_RPL (fchmodat, int, + (int fd, char const *file, mode_t mode, int flag)); +# else +# if !@HAVE_FCHMODAT@ _GL_FUNCDECL_SYS (fchmodat, int, (int fd, char const *file, mode_t mode, int flag) _GL_ARG_NONNULL ((2))); -# endif +# endif _GL_CXXALIAS_SYS (fchmodat, int, (int fd, char const *file, mode_t mode, int flag)); +# endif _GL_CXXALIASWARN (fchmodat); #elif defined GNULIB_POSIXCHECK # undef fchmodat @@ -502,31 +514,24 @@ _GL_WARN_ON_USE (futimens, "futimens is not portable - " #if @GNULIB_LCHMOD@ /* Change the mode of FILENAME to MODE, without dereferencing it if FILENAME denotes a symbolic link. */ -# if !@HAVE_LCHMOD@ -/* The lchmod replacement follows symbolic links. Callers should take - this into account; lchmod should be applied only to arguments that - are known to not be symbolic links. On hosts that lack lchmod, - this can lead to race conditions between the check and the - invocation of lchmod, but we know of no workarounds that are - reliable in general. You might try requesting support for lchmod - from your operating system supplier. */ +# if @REPLACE_LCHMOD@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) -# define lchmod chmod +# undef lchmod +# define lchmod rpl_lchmod # endif -/* Need to cast, because on mingw, the second parameter of chmod is - int mode. */ -_GL_CXXALIAS_RPL_CAST_1 (lchmod, chmod, int, - (const char *filename, mode_t mode)); +_GL_FUNCDECL_RPL (lchmod, int, + (char const *filename, mode_t mode) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (lchmod, int, + (char const *filename, mode_t mode)); # else -# if 0 /* assume already declared */ +# if !@HAVE_LCHMOD@ || defined __hpux _GL_FUNCDECL_SYS (lchmod, int, (const char *filename, mode_t mode) _GL_ARG_NONNULL ((1))); # endif _GL_CXXALIAS_SYS (lchmod, int, (const char *filename, mode_t mode)); # endif -# if @HAVE_LCHMOD@ _GL_CXXALIASWARN (lchmod); -# endif #elif defined GNULIB_POSIXCHECK # undef lchmod # if HAVE_RAW_DECL_LCHMOD diff --git a/lib/tempname.c b/lib/tempname.c index 7c46ad14078..0aad0616c85 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -1,7 +1,6 @@ /* tempname.c - generate the name of a temporary file. - Copyright (C) 1991-2003, 2005-2007, 2009-2020 Free Software - Foundation, Inc. + Copyright (C) 1991-2003, 2005-2007, 2009-2020 Free Software Foundation, Inc. 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 diff --git a/lib/time_r.c b/lib/time_r.c index 25068ad7276..e8fca2d5c44 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -1,7 +1,6 @@ /* Reentrant time functions like localtime_r. - Copyright (C) 2003, 2006-2007, 2010-2020 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2010-2020 Free Software Foundation, Inc. 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 diff --git a/lib/unistd.in.h b/lib/unistd.in.h index ddb7c5771ba..d6176adc00d 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -21,7 +21,7 @@ #endif @PRAGMA_COLUMNS@ -#ifdef _GL_INCLUDING_UNISTD_H +#if @HAVE_UNISTD_H@ && defined _GL_INCLUDING_UNISTD_H /* Special invocation convention: - On Mac OS X 10.3.9 we have a sequence of nested includes <unistd.h> -> <signal.h> -> <pthread.h> -> <unistd.h> @@ -141,7 +141,7 @@ /* Get getopt(), optarg, optind, opterr, optopt. */ -#if @GNULIB_UNISTD_H_GETOPT@ && !defined _GL_SYSTEM_GETOPT +#if @GNULIB_GETOPT_POSIX@ && @GNULIB_UNISTD_H_GETOPT@ && !defined _GL_SYSTEM_GETOPT # include <getopt-cdefs.h> # include <getopt-pfx-core.h> #endif @@ -905,6 +905,11 @@ _GL_WARN_ON_USE (getlogin_r, "getlogin_r is unportable - " _GL_FUNCDECL_RPL (getpagesize, int, (void)); _GL_CXXALIAS_RPL (getpagesize, int, (void)); # else +/* On HP-UX, getpagesize exists, but it is not declared in <unistd.h> even if + the compiler options -D_HPUX_SOURCE -D_XOPEN_SOURCE=600 are used. */ +# if defined __hpux +_GL_FUNCDECL_SYS (getpagesize, int, (void)); +# endif # if !@HAVE_GETPAGESIZE@ # if !defined getpagesize /* This is for POSIX systems. */ @@ -1672,7 +1677,9 @@ _GL_CXXALIAS_RPL (usleep, int, (useconds_t n)); # if !@HAVE_USLEEP@ _GL_FUNCDECL_SYS (usleep, int, (useconds_t n)); # endif -_GL_CXXALIAS_SYS (usleep, int, (useconds_t n)); +/* Need to cast, because on Haiku, the first parameter is + unsigned int n. */ +_GL_CXXALIAS_SYS_CAST (usleep, int, (useconds_t n)); # endif _GL_CXXALIASWARN (usleep); #elif defined GNULIB_POSIXCHECK diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 6e007b566db..13ee23031a0 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -1,7 +1,6 @@ /* xalloc-oversized.h -- memory allocation size checking - Copyright (C) 1990-2000, 2003-2004, 2006-2020 Free Software - Foundation, Inc. + Copyright (C) 1990-2000, 2003-2004, 2006-2020 Free Software Foundation, Inc. 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 diff --git a/lisp/align.el b/lisp/align.el index c1a2b691312..61387b23dc7 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -129,6 +129,8 @@ "Hook that gets run after the aligner has been loaded." :type 'hook :group 'align) +(make-obsolete-variable 'align-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom align-indent-before-aligning nil "If non-nil, indent the marked region before aligning it." diff --git a/lisp/allout.el b/lisp/allout.el index 174f1e3dc21..dedad45f827 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1675,10 +1675,8 @@ valid values." ;; least in emacs 21, 22.1, and xemacs 21.4. (put 'allout-exposure-category 'isearch-open-invisible 'allout-isearch-end-handler) - (if (featurep 'xemacs) - (put 'allout-exposure-category 'start-open t) - (put 'allout-exposure-category 'insert-in-front-hooks - '(allout-overlay-insert-in-front-handler))) + (put 'allout-exposure-category 'insert-in-front-hooks + '(allout-overlay-insert-in-front-handler)) (put 'allout-exposure-category 'modification-hooks '(allout-overlay-interior-modification-handler))) ;;;_ > define-minor-mode allout-mode @@ -2115,9 +2113,7 @@ internal functions use this feature cohesively bunch changes." (allout-show-to-offshoot))) (when (not first) (setq first (point)))) - (goto-char (if (featurep 'xemacs) - (next-property-change (1+ (point)) nil end) - (next-char-property-change (1+ (point)) end)))) + (goto-char (next-char-property-change (1+ (point)) end))) (when first (goto-char first) (condition-case nil @@ -2141,18 +2137,7 @@ See `allout-overlay-interior-modification-handler' for details." (when (and (allout-mode-p) undo-in-progress) (setq allout-just-did-undo t) (if (allout-hidden-p) - (allout-show-children))) - - ;; allout-overlay-interior-modification-handler on an overlay handles - ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. - (when (and (featurep 'xemacs) (allout-mode-p)) - ;; process all of the pending overlays: - (save-excursion - (goto-char beg) - (let ((overlay (allout-get-invisibility-overlay))) - (if overlay - (allout-overlay-interior-modification-handler - overlay nil beg end nil)))))) + (allout-show-children)))) ;;;_ > allout-isearch-end-handler (&optional overlay) (defun allout-isearch-end-handler (&optional _overlay) "Reconcile allout outline exposure on arriving in hidden text after isearch. @@ -2453,7 +2438,7 @@ Outermost is first." (progn (if (and (not (bolp)) (allout-hidden-p (1- (point)))) - (goto-char (allout-previous-single-char-property-change + (goto-char (previous-single-char-property-change (1- (point)) 'invisible))) (move-beginning-of-line 1)) (allout-depth) @@ -3443,7 +3428,7 @@ Offer one suitable for current depth DEPTH as default." (format-message "Select bullet: %s (`%s' default): " sans-escapes - (allout-substring-no-properties default-bullet)) + (substring-no-properties default-bullet)) sans-escapes t))) (message "") @@ -4458,9 +4443,9 @@ Topic exposure is marked with text-properties, to be used by (if (not (allout-hidden-p)) (setq next (max (1+ (point)) - (allout-next-single-char-property-change (point) - 'invisible - nil end)))) + (next-single-char-property-change (point) + 'invisible + nil end)))) (if (or (not next) (eq prev next)) ;; still not at start of hidden area -- must not be any left. (setq done t) @@ -4499,7 +4484,7 @@ Topic exposure is marked with text-properties, to be used by (while (not done) ;; at or advance to start of next annotation: (if (not (get-text-property (point) 'allout-was-hidden)) - (setq next (allout-next-single-char-property-change + (setq next (next-single-char-property-change (point) 'allout-was-hidden nil end))) (if (or (not next) (eq prev next)) ;; no more or not advancing -- must not be any left. @@ -4510,7 +4495,7 @@ Topic exposure is marked with text-properties, to be used by ;; still not at start of annotation. (setq done t) ;; advance to just after end of this annotation: - (setq next (allout-next-single-char-property-change + (setq next (next-single-char-property-change (point) 'allout-was-hidden nil end)) (let ((o (make-overlay prev next nil 'front-advance))) (overlay-put o 'category 'allout-exposure-category) @@ -4543,12 +4528,12 @@ however, are left exactly like normal, non-allout-specific yanks." (interactive "*P") ; Get to beginning, leaving ; region around subject: - (if (< (allout-mark-marker t) (point)) + (if (< (mark-marker) (point)) (exchange-point-and-mark)) (save-match-data (let* ((subj-beg (point)) (into-bol (bolp)) - (subj-end (allout-mark-marker t)) + (subj-end (mark-marker)) ;; 'resituate' if yanking an entire topic into topic header: (resituate (and (let ((allout-inhibit-aberrance-doublecheck t)) (allout-e-o-prefix-p)) @@ -4642,8 +4627,8 @@ however, are left exactly like normal, non-allout-specific yanks." t))) (message "")))) (if (or into-bol resituate) - (allout-hide-by-annotation (point) (allout-mark-marker t)) - (allout-deannotate-hidden (allout-mark-marker t) (point))) + (allout-hide-by-annotation (point) (mark-marker)) + (allout-deannotate-hidden (mark-marker) (point))) (if (not resituate) (exchange-point-and-mark)) (run-hook-with-args 'allout-structure-added-functions subj-beg subj-end)))) @@ -4752,14 +4737,7 @@ this function." (when flag (let ((o (make-overlay from to nil 'front-advance))) (overlay-put o 'category 'allout-exposure-category) - (overlay-put o 'evaporate t) - (when (featurep 'xemacs) - (let ((props (symbol-plist 'allout-exposure-category))) - (while props - (condition-case nil - ;; as of 2008-02-27, xemacs lacks modification-hooks - (overlay-put o (pop props) (pop props)) - (error nil)))))) + (overlay-put o 'evaporate t)) (setq allout-this-command-hid-text t)) (run-hook-with-args 'allout-exposure-change-functions from to flag)) ;;;_ > allout-flag-current-subtree (flag) @@ -5946,7 +5924,7 @@ See `allout-toggle-current-subtree-encryption' for more details." ;; they're encrypted, so the coding system is set to accommodate ;; them. (setq buffer-file-coding-system - (allout-select-safe-coding-system subtree-beg subtree-end)) + (select-safe-coding-system subtree-beg subtree-end)) ;; if the coding system for the text being encrypted is different ;; from that prevailing, then there a real risk that the coding ;; system can't be noticed by emacs when the file is visited. to @@ -6542,204 +6520,15 @@ If BEG is bigger than END we return 0." (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char))) string))) (define-obsolete-function-alias 'allout-flatten #'flatten-tree "27.1") -;;;_ : Compatibility: -;;;_ : xemacs undo-in-progress provision: -(unless (boundp 'undo-in-progress) - (defvar undo-in-progress nil - "Placeholder defvar for XEmacs compatibility from allout.el.") - (defadvice undo-more (around allout activate) - ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs. - (let ((undo-in-progress t)) ad-do-it))) - -;;;_ > allout-mark-marker to accommodate divergent emacsen: -(defun allout-mark-marker (&optional force buffer) - "Accommodate the different signature for `mark-marker' across Emacsen. - -XEmacs takes two optional args, while Emacs does not, -so pass them along when appropriate." - (if (featurep 'xemacs) - (apply 'mark-marker force buffer) - (mark-marker))) -;;;_ > subst-char-in-string if necessary -(if (not (fboundp 'subst-char-in-string)) - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. -Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> i 0) - (setq i (1- i)) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) -;;;_ > wholenump if necessary -(if (not (fboundp 'wholenump)) - (defalias 'wholenump 'natnump)) -;;;_ > remove-overlays if necessary -(if (not (fboundp 'remove-overlays)) - (defun remove-overlays (&optional beg end name val) - "Clear BEG and END of overlays whose property NAME has value VAL. -Overlays might be moved and/or split. -BEG and END default respectively to the beginning and end of buffer." - (unless beg (setq beg (point-min))) - (unless end (setq end (point-max))) - (if (< end beg) - (setq beg (prog1 end (setq end beg)))) - (save-excursion - (dolist (o (overlays-in beg end)) - (when (eq (overlay-get o name) val) - ;; Either push this overlay outside beg...end - ;; or split it to exclude beg...end - ;; or delete it entirely (if it is contained in beg...end). - (if (< (overlay-start o) beg) - (if (> (overlay-end o) end) - (progn - (move-overlay (copy-overlay o) - (overlay-start o) beg) - (move-overlay o end (overlay-end o))) - (move-overlay o (overlay-start o) beg)) - (if (> (overlay-end o) end) - (move-overlay o end (overlay-end o)) - (delete-overlay o))))))) - ) -;;;_ > copy-overlay if necessary -- xemacs ~ 21.4 -(if (not (fboundp 'copy-overlay)) - (defun copy-overlay (o) - "Return a copy of overlay O." - (let ((o1 (make-overlay (overlay-start o) (overlay-end o) - ;; FIXME: there's no easy way to find the - ;; insertion-type of the two markers. - (overlay-buffer o))) - (props (overlay-properties o))) - (while props - (overlay-put o1 (pop props) (pop props))) - o1))) -;;;_ > add-to-invisibility-spec if necessary -- xemacs ~ 21.4 -(if (not (fboundp 'add-to-invisibility-spec)) - (defun add-to-invisibility-spec (element) - "Add ELEMENT to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (if (eq buffer-invisibility-spec t) - (setq buffer-invisibility-spec (list t))) - (setq buffer-invisibility-spec - (cons element buffer-invisibility-spec)))) -;;;_ > remove-from-invisibility-spec if necessary -- xemacs ~ 21.4 -(if (not (fboundp 'remove-from-invisibility-spec)) - (defun remove-from-invisibility-spec (element) - "Remove ELEMENT from `buffer-invisibility-spec'." - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec (delete element - buffer-invisibility-spec))))) -;;;_ > move-beginning-of-line if necessary -- older emacs, xemacs -(if (not (fboundp 'move-beginning-of-line)) - (defun move-beginning-of-line (arg) - "Move point to beginning of current line as displayed. -\(This disregards invisible newlines such as those -which are part of the text that an image rests on.) - -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If point reaches the beginning or end of buffer, it stops there. -To ignore intangibility, bind `inhibit-point-motion-hooks' to t." - (interactive "p") - (or arg (setq arg 1)) - (if (/= arg 1) - (condition-case nil (line-move (1- arg)) (error nil))) - - ;; Move to beginning-of-line, ignoring fields and invisible text. - (skip-chars-backward "^\n") - (while (and (not (bobp)) - (let ((prop - (get-char-property (1- (point)) 'invisible))) - (if (eq buffer-invisibility-spec t) - prop - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec))))) - (goto-char (if (featurep 'xemacs) - (previous-property-change (point)) - (previous-char-property-change (point)))) - (skip-chars-backward "^\n")) - (vertical-motion 0)) -) -;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs -(if (not (fboundp 'move-end-of-line)) - (defun move-end-of-line (arg) - "Move point to end of current line as displayed. -\(This disregards invisible newlines such as those -which are part of the text that an image rests on.) - -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If point reaches the beginning or end of buffer, it stops there. -To ignore intangibility, bind `inhibit-point-motion-hooks' to t." - (interactive "p") - (or arg (setq arg 1)) - (let (done) - (while (not done) - (let ((newpos - (save-excursion - (let ((goal-column 0)) - (and (condition-case nil - (or (line-move arg) t) - (error nil)) - (not (bobp)) - (progn - (while - (and - (not (bobp)) - (let ((prop - (get-char-property (1- (point)) - 'invisible))) - (if (eq buffer-invisibility-spec t) - prop - (or (memq prop - buffer-invisibility-spec) - (assq prop - buffer-invisibility-spec))))) - (goto-char - (previous-char-property-change (point)))) - (backward-char 1))) - (point))))) - (goto-char newpos) - (if (and (> (point) newpos) - (eq (preceding-char) ?\n)) - (backward-char 1) - (if (and (> (point) newpos) (not (eobp)) - (not (eq (following-char) ?\n))) - ;; If we skipped something intangible - ;; and now we're not really at eol, - ;; keep going. - (setq arg 1) - (setq done t))))))) - ) -;;;_ > allout-next-single-char-property-change -- alias unless lacking -(defalias 'allout-next-single-char-property-change - (if (fboundp 'next-single-char-property-change) - 'next-single-char-property-change - 'next-single-property-change) - ;; No docstring because xemacs defalias doesn't support it. - ) -;;;_ > allout-previous-single-char-property-change -- alias unless lacking -(defalias 'allout-previous-single-char-property-change - (if (fboundp 'previous-single-char-property-change) - 'previous-single-char-property-change - 'previous-single-property-change) - ;; No docstring because xemacs defalias doesn't support it. - ) -;;;_ > allout-select-safe-coding-system -(defalias 'allout-select-safe-coding-system - (if (fboundp 'select-safe-coding-system) - 'select-safe-coding-system - 'detect-coding-region) - ) -;;;_ > allout-substring-no-properties -;; define as alias first, so byte compiler is happy. -(defalias 'allout-substring-no-properties 'substring-no-properties) -;; then supplant with definition if underlying alias absent. -(if (not (fboundp 'substring-no-properties)) - (defun allout-substring-no-properties (string &optional start end) - (substring string (or start 0) end)) - ) - +(define-obsolete-function-alias 'allout-mark-marker #'mark-marker "28.1") +(define-obsolete-function-alias 'allout-substring-no-properties + #'substring-no-properties "28.1") +(define-obsolete-function-alias 'allout-select-safe-coding-system + #'select-safe-coding-system "28.1") +(define-obsolete-function-alias 'allout-previous-single-char-property-change + #'previous-single-char-property-change "28.1") +(define-obsolete-function-alias 'allout-next-single-char-property-change + #'next-single-char-property-change "28.1") ;;;_ #10 Unfinished ;;;_ > allout-bullet-isearch (&optional bullet) (defun allout-bullet-isearch (&optional bullet) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index d6e85bf3835..677483e49f2 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1797,8 +1797,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (maxlen 8) (totalsize 0) files - visual - emacs-int-has-32bits) + visual) (when (= p -1) ;; If the offset of end-of-central-directory is -1, this is a ;; Zip64 extended ZIP file format, and we need to glean the info diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 3151b6e590d..e023c8fc7a6 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -242,6 +242,8 @@ For more information, see Info node `(emacs)Autorevert'." :tag "Load Hook" :group 'auto-revert :type 'hook) +(make-obsolete-variable 'auto-revert-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom auto-revert-check-vc-info nil "If non-nil Auto-Revert Mode reliably updates version control info. diff --git a/lisp/battery.el b/lisp/battery.el index 1d3390070c3..7027b254480 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -1,8 +1,9 @@ -;;; battery.el --- display battery status information +;;; battery.el --- display battery status information -*- lexical-binding:t -*- ;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc. ;; Author: Ralph Schleicher <rs@ralph-schleicher.de> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: hardware ;; This file is part of GNU Emacs. @@ -22,15 +23,19 @@ ;;; Commentary: -;; There is at present support for GNU/Linux, macOS and Windows. This -;; library supports both the `/proc/apm' file format of Linux version -;; 1.3.58 or newer and the `/proc/acpi/' directory structure of Linux -;; 2.4.20 and 2.6. Darwin (macOS) is supported by using the `pmset' -;; program. Windows is supported by the GetSystemPowerStatus API call. +;; There is at present support for GNU/Linux, macOS, and Windows. +;; This library supports: +;; - UPower (https://upower.freedesktop.org) via D-Bus API. +;; - the `/sys/class/power_supply/' files of Linux >= 2.6.39. +;; - the `/proc/acpi/' directory structure of Linux 2.4.20 and 2.6. +;; - the `/proc/apm' file format of Linux version 1.3.58 or newer. +;; - Darwin (macOS) by using the `pmset' program. +;; - Windows via the GetSystemPowerStatus API call. ;;; Code: (require 'timer) +(require 'dbus) (eval-when-compile (require 'cl-lib)) (defgroup battery nil @@ -38,11 +43,22 @@ :prefix "battery-" :group 'hardware) -(defcustom battery-upower-device "battery_BAT1" - "Upower battery device name." - :version "26.1" - :type 'string - :group 'battery) +(defcustom battery-upower-device nil + "UPower device of the `:battery' type. +Use `battery-upower-device-list' to list all available UPower devices. +If set to nil, then autodetect `:battery' device." + :version "28.1" + :type '(choice string (const :tag "Autodetect" nil))) + +(defcustom battery-upower-line-power-device nil + "UPower device of the `:line-power' type. +Use `battery-upower-device-list' to list all available UPower devices. +If set to nil, then autodetect `:battery' device." + :version "28.1" + :type '(choice string (const :tag "Autodetect" nil))) + +(defconst battery-upower-dbus-service "org.freedesktop.UPower" + "Well-known UPower service name for the D-Bus system.") (defun battery--find-linux-sysfs-batteries () (let ((dirs nil)) @@ -54,7 +70,9 @@ (nreverse dirs))) (defcustom battery-status-function - (cond ((and (eq system-type 'gnu/linux) + (cond ((dbus-ping :system battery-upower-dbus-service) + #'battery-upower) + ((and (eq system-type 'gnu/linux) (file-readable-p "/proc/apm")) #'battery-linux-proc-apm) ((and (eq system-type 'gnu/linux) @@ -84,8 +102,7 @@ Its cons cells are of the form CONVERSION is the character code of a \"conversion specification\" introduced by a `%' character in a control string." - :type '(choice (const nil) function) - :group 'battery) + :type '(choice (const nil) function)) (defcustom battery-echo-area-format "Power %L, battery %B (%p%% load, remaining time %t)" @@ -105,8 +122,7 @@ string are substituted as defined by the current value of the variable %m Remaining time (to charge or discharge) in minutes %h Remaining time (to charge or discharge) in hours %t Remaining time (to charge or discharge) in the form `h:min'" - :type '(choice string (const nil)) - :group 'battery) + :type '(choice string (const nil))) (defvar battery-mode-line-string nil "String to display in the mode line.") @@ -115,8 +131,7 @@ string are substituted as defined by the current value of the variable (defcustom battery-mode-line-limit 100 "Percentage of full battery load below which display battery status." :version "24.1" - :type 'integer - :group 'battery) + :type 'integer) (defcustom battery-mode-line-format (cond ((eq battery-status-function 'battery-linux-proc-acpi) @@ -139,25 +154,21 @@ string are substituted as defined by the current value of the variable %m Remaining time (to charge or discharge) in minutes %h Remaining time (to charge or discharge) in hours %t Remaining time (to charge or discharge) in the form `h:min'" - :type '(choice string (const nil)) - :group 'battery) + :type '(choice string (const nil))) (defcustom battery-update-interval 60 "Seconds after which the battery status will be updated." - :type 'integer - :group 'battery) + :type 'integer) (defcustom battery-load-low 25 "Upper bound of low battery load percentage. A battery load percentage below this number is considered low." - :type 'integer - :group 'battery) + :type 'integer) (defcustom battery-load-critical 10 "Upper bound of critical battery load percentage. A battery load percentage below this number is considered critical." - :type 'integer - :group 'battery) + :type 'integer) (defvar battery-update-timer nil "Interval timer object.") @@ -181,7 +192,7 @@ The text displayed in the mode line is controlled by `battery-mode-line-format' and `battery-status-function'. The mode line is be updated every `battery-update-interval' seconds." - :global t :group 'battery + :global t (setq battery-mode-line-string "") (or global-mode-string (setq global-mode-string '(""))) (and battery-update-timer (cancel-timer battery-update-timer)) @@ -537,17 +548,68 @@ The following %-sequences are provided: (t "N/A")))))) -(declare-function dbus-get-property "dbus.el" - (bus service path interface property)) - ;;; `upowerd' interface. -(defsubst battery-upower-prop (pname &optional device) +(defconst battery-upower-dbus-interface "org.freedesktop.UPower" + "The interface to UPower. +See URL `https://upower.freedesktop.org/docs/'.") + +(defconst battery-upower-dbus-path "/org/freedesktop/UPower" + "D-Bus path to talk to UPower service.") + +(defconst battery-upower-dbus-device-interface + (concat battery-upower-dbus-interface ".Device") + "The Device interface of the UPower. +See URL `https://upower.freedesktop.org/docs/Device.html'.") + +(defconst battery-upower-dbus-device-path + (concat battery-upower-dbus-path "/devices") + "D-Bus path to talk to devices part of the UPower service.") + +(defconst battery-upower-types + '((0 . :unknown) (1 . :line-power) (2 . :battery) + (3 . :ups) (4 . :monitor) (5 . :mouse) + (6 . :keyboard) (7 . :pda) (8 . :phone)) + "Type of the device.") + +(defconst battery-upower-states + '((0 . "unknown") (1 . "charging") (2 . "discharging") + (3 . "empty") (4 . "fully-charged") (5 . "pending-charge") + (6 . "pending-discharge")) + "Alist of battery power states. +Only valid for `:battery' devices.") + +(defun battery-upower-device-property (device property) + "Get value of the single PROPERTY for the UPower DEVICE." (dbus-get-property - :system - "org.freedesktop.UPower" - (concat "/org/freedesktop/UPower/devices/" (or device battery-upower-device)) - "org.freedesktop.UPower" - pname)) + :system battery-upower-dbus-service + (expand-file-name device battery-upower-dbus-device-path) + battery-upower-dbus-device-interface + property)) + +(defun battery-upower-device-all-properties (device) + "Return value for all available properties for the UPower DEVICE." + (dbus-get-all-properties + :system battery-upower-dbus-service + (expand-file-name device battery-upower-dbus-device-path) + battery-upower-dbus-device-interface)) + +(defun battery-upower-device-list () + "Return list of all available UPower devices. +Each element is the cons cell in form: (DEVICE . DEVICE-TYPE)." + (mapcar (lambda (device-path) + (let* ((device (file-relative-name + device-path battery-upower-dbus-device-path)) + (type-num (battery-upower-device-property device "Type"))) + (cons device (or (cdr (assq type-num battery-upower-types)) + :unknown)))) + (dbus-call-method :system battery-upower-dbus-service + battery-upower-dbus-path + battery-upower-dbus-interface + "EnumerateDevices"))) + +(defun battery-upower-device-autodetect (device-type) + "Return first matching UPower device of DEVICE-TYPE." + (car (rassq device-type (battery-upower-device-list)))) (defun battery-upower () "Get battery status from dbus Upower interface. @@ -559,45 +621,49 @@ The following %-sequences are provided: %p Battery load percentage %r Current rate %B Battery status (verbose) +%b Battery status: empty means high, `-' means low, + `!' means critical, and `+' means charging %L AC line status (verbose) %s Remaining time (to charge or discharge) in seconds %m Remaining time (to charge or discharge) in minutes %h Remaining time (to charge or discharge) in hours %t Remaining time (to charge or discharge) in the form `h:min'" - (let ((percents (battery-upower-prop "Percentage")) - (time-to-empty (battery-upower-prop "TimeToEmpty")) - (time-to-full (battery-upower-prop "TimeToFull")) - (state (battery-upower-prop "State")) - (online (battery-upower-prop "Online" "line_power_ACAD")) - (energy (battery-upower-prop "Energy")) - (energy-rate (battery-upower-prop "EnergyRate")) - (battery-states '((0 . "unknown") (1 . "charging") - (2 . "discharging") (3 . "empty") - (4 . "fully-charged") (5 . "pending-charge") - (6 . "pending-discharge"))) - seconds minutes hours remaining-time) - (cond ((and online time-to-full) - (setq seconds time-to-full)) - ((and (not online) time-to-empty) - (setq seconds time-to-empty))) - (when seconds - (setq minutes (/ seconds 60) - hours (/ minutes 60) - remaining-time (format "%d:%02d" hours (mod minutes 60)))) - (list (cons ?c (or (and energy - (number-to-string (round (* 1000 energy)))) - "N/A")) - (cons ?p (or (and percents (number-to-string (round percents))) - "N/A")) - (cons ?r (or (and energy-rate - (concat (number-to-string energy-rate) " W")) - "N/A")) - (cons ?B (or (and state (cdr (assoc state battery-states))) - "unknown")) - (cons ?L (or (and online "on-line") "off-line")) - (cons ?s (or (and seconds (number-to-string seconds)) "N/A")) - (cons ?m (or (and minutes (number-to-string minutes)) "N/A")) - (cons ?h (or (and hours (number-to-string hours)) "N/A")) + (let* ((bat-device (or battery-upower-device + (battery-upower-device-autodetect :battery))) + (bat-props (when bat-device + (battery-upower-device-all-properties bat-device))) + (percents (cdr (assoc "Percentage" bat-props))) + (time-to-empty (cdr (assoc "TimeToEmpty" bat-props))) + (time-to-full (cdr (assoc "TimeToFull" bat-props))) + (state (cdr (assoc "State" bat-props))) + (level (cdr (assoc "BatteryLevel" bat-props))) + (energy (cdr (assoc "Energy" bat-props))) + (energy-rate (cdr (assoc "EnergyRate" bat-props))) + (lp-device (or battery-upower-line-power-device + (battery-upower-device-autodetect :line-power))) + (online-p (when lp-device + (battery-upower-device-property lp-device "Online"))) + (seconds (if online-p time-to-full time-to-empty)) + (minutes (when seconds (/ seconds 60))) + (hours (when minutes (/ minutes 60))) + (remaining-time (when hours + (format "%d:%02d" hours (mod minutes 60))))) + (list (cons ?c (if energy (number-to-string (round (* 1000 energy))) "N/A")) + (cons ?p (if percents (number-to-string (round percents)) "N/A")) + (cons ?r (if energy-rate + (concat (number-to-string energy-rate) " W") + "N/A")) + (cons ?B (if state + (cdr (assq state battery-upower-states)) + "unknown")) + (cons ?b (cond ((= level 3) "-") + ((= level 4) "!") + (online-p "+") + (t ""))) + (cons ?L (if online-p "on-line" (if lp-device "off-line" "unknown"))) + (cons ?s (if seconds (number-to-string seconds) "N/A")) + (cons ?m (if minutes (number-to-string minutes) "N/A")) + (cons ?h (if hours (number-to-string hours) "N/A")) (cons ?t (or remaining-time "N/A"))))) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 6cd624cb333..720ad18c16f 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2321,6 +2321,8 @@ strings returned are not." ;; Load Hook (defvar bookmark-load-hook nil "Hook run at the end of loading library `bookmark.el'.") +(make-obsolete-variable 'bookmark-load-hook + "use `with-eval-after-load' instead." "28.1") ;; Exit Hook, called from kill-emacs-hook (defvar bookmark-exit-hook nil diff --git a/lisp/bs.el b/lisp/bs.el index f5cb93b5169..337d22ecf83 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -173,7 +173,12 @@ return a string representing the column's value." (defun bs--make-header-match-string () "Return a regexp matching the first line of a Buffer Selection Menu buffer." - (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)")) + (concat "^\\(" + (apply #'concat (mapcan (lambda (e) + (and (not (equal (car e) "")) + (list " *" (car e)))) + bs-attributes-list)) + " *$\\)")) ;; Font-Lock-Settings (defvar bs-mode-font-lock-keywords diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index b519559330e..4b2a938a5f1 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -884,6 +884,8 @@ Used by `calc-user-invocation'.") (defvar calc-load-hook nil "Hook run when calc.el is loaded.") +(make-obsolete-variable 'calc-load-hook + "use `with-eval-after-load' instead." "28.1") (defvar calc-window-hook nil "Hook called to create the Calc window.") diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 6d262088479..da98e44926e 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -98,7 +98,7 @@ specifies which face attribute (e.g. `:foreground') to modify, or that this is a face (`:face') to apply. TYPE is the type of attribute being applied. Available TYPES (see `diary-attrtype-convert') are: `string', `symbol', `int', `tnil', `stringtnil'." - :type '(repeat (list (string :tag "Regular expression") + :type '(repeat (list (regexp :tag "Regular expression") (integer :tag "Sub-expression") (symbol :tag "Attribute (e.g. :foreground)") (choice (const string :tag "A string") diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el index ae1dab17252..906c29b15f4 100644 --- a/lisp/calendar/iso8601.el +++ b/lisp/calendar/iso8601.el @@ -69,6 +69,8 @@ "\\([+-]?[0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)") (defconst iso8601--outdated-date-match "--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)") +(defconst iso8601--outdated-reduced-precision-date-match + "---?\\([0-9][0-9]\\)") (defconst iso8601--week-date-match "\\([+-]?[0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?") (defconst iso8601--ordinal-date-match @@ -79,6 +81,7 @@ iso8601--full-date-match iso8601--without-day-match iso8601--outdated-date-match + iso8601--outdated-reduced-precision-date-match iso8601--week-date-match iso8601--ordinal-date-match))) @@ -136,7 +139,8 @@ See `decode-time' for the meaning of FORM." (when zone-string (setf (decoded-time-zone date) ;; The time zone in decoded times are in seconds. - (* (iso8601-parse-zone zone-string) 60))) + (* (iso8601-parse-zone zone-string) 60)) + (setf (decoded-time-dst date) nil)) date))) (defun iso8601-parse-date (string) @@ -201,6 +205,12 @@ See `decode-time' for the meaning of FORM." (iso8601--decoded-time :year year :month (decoded-time-month month-day) :day (decoded-time-day month-day)))) + ;; Obsolete format with implied year: --MM + ((iso8601--match "--\\([0-9][0-9]\\)" string) + (iso8601--decoded-time :month (string-to-number (match-string 1 string)))) + ;; Obsolete format with implied year and month: ---DD + ((iso8601--match "---\\([0-9][0-9]\\)" string) + (iso8601--decoded-time :day (string-to-number (match-string 1 string)))) (t (signal 'wrong-type-argument string)))) @@ -332,6 +342,9 @@ Return the number of minutes." (list start end (or duration ;; FIXME: Support subseconds. + ;; FIXME: It makes no sense to decode a time difference + ;; according to (decoded-time-zone end), or according to + ;; any other time zone for that matter. (decode-time (time-subtract (iso8601--encode-time end) (iso8601--encode-time start)) (or (decoded-time-zone end) 0) 'integer))))) @@ -354,7 +367,7 @@ Return the number of minutes." (iso8601--value month) (iso8601--value year) nil - dst + (if (or dst zone) dst -1) zone)) (defun iso8601--encode-time (time) diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 616d2b0c4ed..3d5a0a236b4 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -91,6 +91,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, (* -0.0016528 time time) (* -0.00000239 time time time)) 360.0)) + (eclipse (eclipse-check moon-lat phase)) (adjustment (if (memq phase '(0 2)) (+ (* (- 0.1734 (* 0.000393 time)) @@ -146,7 +147,26 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon, (time (* 24 (- date (truncate date)))) (date (calendar-gregorian-from-absolute (truncate date))) (adj (dst-adjust-time date time))) - (list (car adj) (apply 'solar-time-string (cdr adj)) phase))) + (list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse))) + +;; from "Astronomy with your Personal Computer", Subroutine Eclipse +;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990 +(defun eclipse-check (moon-lat phase) + (let* ((moon-lat (* (/ float-pi 180) moon-lat)) + (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi)) + float-pi)))) + (moon-lat (if (> moon-lat 0.37) + (- float-pi moon-lat) + moon-lat)) + (phase-name (cond ((= phase 0) "Solar") + ((= phase 2) "Lunar") + (t "")))) + (cond ((< moon-lat 2.42600766e-1) + (concat "** " phase-name " Eclipse **")) + ((< moon-lat 0.37) + (concat "** " phase-name " Eclipse possible **")) + (t + "")))) (defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853 "Mean number of lunar cycles per 365.25 day year.") @@ -222,9 +242,10 @@ use instead of point." (insert (mapconcat (lambda (x) - (format "%s: %s %s" (calendar-date-string (car x)) + (format "%s: %s %s %s" (calendar-date-string (car x)) (lunar-phase-name (nth 2 x)) - (cadr x))) + (cadr x) + (car (last x)))) (lunar-phase-list m1 y1) "\n"))) (message "Computing phases of the moon...done")))) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 7110a81f0de..b199fca2db5 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -149,62 +149,62 @@ letters, digits, plus or minus signs or colons." ;;;###autoload (defun parse-time-string (string) "Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -STRING should be something resembling an RFC 822 (or later) date-time, e.g., -\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is +STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\", +or something resembling an RFC 822 (or later) date-time, e.g., +\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is somewhat liberal in what format it accepts, and will attempt to return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but any unknown values other than DST are returned as nil, and an unknown DST value is returned as -1." - (let ((time (list nil nil nil nil nil nil nil -1 nil)) - (temp (parse-time-tokenize (downcase string)))) - (while temp - (let ((parse-time-elt (pop temp)) - (rules parse-time-rules) - (exit nil)) - (while (and rules (not exit)) - (let* ((rule (pop rules)) - (slots (pop rule)) - (predicate (pop rule)) - (parse-time-val)) - (when (and (not (nth (car slots) time)) ;not already set - (setq parse-time-val - (cond ((and (consp predicate) - (not (functionp predicate))) - (and (numberp parse-time-elt) - (<= (car predicate) parse-time-elt) - (or (not (cdr predicate)) - (<= parse-time-elt - (cadr predicate))) - parse-time-elt)) - ((symbolp predicate) - (cdr (assoc parse-time-elt - (symbol-value predicate)))) - ((funcall predicate))))) - (setq exit t) - (while slots - (let ((new-val (if rule - (let ((this (pop rule))) - (if (vectorp this) - (cl-parse-integer - parse-time-elt - :start (aref this 0) - :end (aref this 1)) - (funcall this))) - parse-time-val))) - (setf (nth (pop slots) time) new-val)))))))) - time)) + (condition-case () + (iso8601-parse string) + (wrong-type-argument + (let ((time (list nil nil nil nil nil nil nil -1 nil)) + (temp (parse-time-tokenize (downcase string)))) + (while temp + (let ((parse-time-elt (pop temp)) + (rules parse-time-rules) + (exit nil)) + (while (and rules (not exit)) + (let* ((rule (pop rules)) + (slots (pop rule)) + (predicate (pop rule)) + (parse-time-val)) + (when (and (not (nth (car slots) time)) ;not already set + (setq parse-time-val + (cond ((and (consp predicate) + (not (functionp predicate))) + (and (numberp parse-time-elt) + (<= (car predicate) parse-time-elt) + (or (not (cdr predicate)) + (<= parse-time-elt + (cadr predicate))) + parse-time-elt)) + ((symbolp predicate) + (cdr (assoc parse-time-elt + (symbol-value predicate)))) + ((funcall predicate))))) + (setq exit t) + (while slots + (let ((new-val (if rule + (let ((this (pop rule))) + (if (vectorp this) + (cl-parse-integer + parse-time-elt + :start (aref this 0) + :end (aref this 1)) + (funcall this))) + parse-time-val))) + (setf (nth (pop slots) time) new-val)))))))) + time)))) (defun parse-iso8601-time-string (date-string) - "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00. -If DATE-STRING cannot be parsed, it falls back to -`parse-time-string'." - (when-let ((time - (if (iso8601-valid-p date-string) - (decoded-time-set-defaults (iso8601-parse date-string)) - ;; Fall back to having `parse-time-string' do fancy - ;; things for us. - (parse-time-string date-string)))) + "Parse an ISO 8601 time string, such as \"2020-01-15T16:12:21-08:00\". +Fall back on parsing something resembling an RFC 822 (or later) date-time. +This function is like `parse-time-string' except that it returns +a Lisp timestamp when successful." + (when-let ((time (parse-time-string date-string))) (encode-time time))) (provide 'parse-time) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 1e589ece29d..e2402de8010 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -515,15 +515,14 @@ TIME is modified and returned." (unless (decoded-time-year time) (setf (decoded-time-year time) 0)) - ;; When we don't have a time zone and we don't have a DST, then mark - ;; it as unknown. - (when (and (not (decoded-time-zone time)) - (not (decoded-time-dst time))) - (setf (decoded-time-dst time) -1)) - - (when (and (not (decoded-time-zone time)) - default-zone) - (setf (decoded-time-zone time) 0)) + ;; When we don't have a time zone, default to DEFAULT-ZONE without + ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise. + (unless (decoded-time-zone time) + (if default-zone + (progn (setf (decoded-time-zone time) default-zone) + (setf (decoded-time-dst time) nil)) + (setf (decoded-time-dst time) -1))) + time) (provide 'time-date) diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index f3a5d9cd60d..d12feaae8c3 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -193,6 +193,8 @@ to today." (defcustom timeclock-load-hook nil "Hook that gets run after timeclock has been loaded." :type 'hook) +(make-obsolete-variable 'timeclock-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom timeclock-in-hook nil "A hook run every time an \"in\" event is recorded." diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index 78a72dd889c..075e122e79d 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -880,7 +880,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing." comment-end "" buffer-read-only t) (setq-local comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (buffer-disable-undo) (set (make-local-variable 'font-lock-global-modes) nil) (font-lock-mode -1) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 1418ad9539d..c2036878288 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1527,8 +1527,7 @@ It does not apply the value to buffers." ;; If this does not occur after the provide, we can get a recursive ;; load. Yuck! -(if (featurep 'speedbar) - (ede-speedbar-file-setup) - (add-hook 'speedbar-load-hook 'ede-speedbar-file-setup)) +(with-eval-after-load 'speedbar + (ede-speedbar-file-setup)) ;;; ede.el ends here diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index ee8aa5db1b7..f0dbccb7fc1 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -478,21 +478,6 @@ Argument COMMAND is the command to use for compiling the target." "Don't rescan this project from the sources." (message "cpp-root has nothing to rescan.")) -;;; Quick Hack -(defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes) - "Create a bunch of projects under directory DIR. -PROJFILE is a file name sans directory that indicates a subdirectory -is a project directory. -Generic ATTRIBUTES, such as :include-path can be added. -Note: This needs some work." - (let ((files (directory-files dir t))) - (dolist (F files) - (if (file-exists-p (expand-file-name projfile F)) - `(ede-cpp-root-project (file-name-nondirectory F) - :name (file-name-nondirectory F) - :file (expand-file-name projfile F) - attributes))))) - (provide 'ede/cpp-root) ;; Local variables: diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index 63fb62b5a57..b85b397af2d 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -56,8 +56,9 @@ don't do it. A value of nil means to just do it.") (and (eq ede-pconf-create-file-query 'ask) (not (eq ede-pconf-create-file-query 'never)) (not (y-or-n-p - (format "I had to create the %s file for you. Ok? " file))) - (error "Quit"))))))) + (format "I had to create the %s file for you. Ok? " + file)))) + (error "Quit")))))) (cl-defmethod ede-proj-configure-synchronize ((this ede-proj-project)) diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 55e755dc363..214291797db 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -74,7 +74,7 @@ By default, include only headers since the semantic use of EBrowse is only for searching via semanticdb, and thus only headers would be searched." :group 'semanticdb - :type 'string) + :type 'regexp) ;;; SEMANTIC Database related Code ;;; Classes: diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 62c86f9d12d..2c3b24b9b16 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1306,7 +1306,7 @@ the change bounds to encompass the whole nonterminal tag." ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. (set (make-local-variable 'comment-start-skip) - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (set (make-local-variable 'indent-line-function) 'semantic-grammar-indent) (set (make-local-variable 'fill-paragraph-function) diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index 19e0515ac63..cdf0a23fa07 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -44,9 +44,8 @@ ;; Because semantic imenu tags will hose the current imenu handling ;; code in speedbar, force semantic/sb in. -(if (featurep 'speedbar) - (require 'semantic/sb) - (add-hook 'speedbar-load-hook (lambda () (require 'semantic/sb)))) +(with-eval-after-load 'speedbar + (require 'semantic/sb)) (defgroup semantic-imenu nil "Semantic interface to Imenu." diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index 4151b17c885..fdb44695918 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -89,7 +89,7 @@ versions of names. This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-function-alist @@ -145,7 +145,7 @@ see how best to describe what can be returned. Doesn't always work correctly, but that is just because English doesn't always work correctly." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-common-nouns-abbrevs @@ -176,7 +176,7 @@ versions of names. This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-return-first-alist @@ -193,7 +193,7 @@ This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-return-last-alist @@ -214,7 +214,7 @@ MATCH is a regexp to match in the type field. RESULT is a string, which can contain %s, which is replaced with `match-string' 1." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-param-alist @@ -234,7 +234,7 @@ RESULT is a string of text to use to describe MATCH. When one is encountered, document-insert-parameters will automatically place this comment after the parameter name." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) (defcustom srecode-document-autocomment-param-type-alist @@ -259,7 +259,7 @@ This is an alist with each element of the form: MATCH is a regexp to match in the type field. RESULT is a string." :group 'document - :type '(repeat (cons (string :tag "Regexp") + :type '(repeat (cons (regexp :tag "Regexp") (string :tag "Doc Text")))) ;;;###autoload diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 26c14892efd..5b2dd034743 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -201,7 +201,7 @@ variable default values, and other things." (let ((tag (or srecode-semantic-selected-tag (srecode-semantic-tag-from-kill-ring)))) (when (not tag) - "No tag for current template. Use the semantic kill-ring.") + (error "No tag for current template. Use the semantic kill-ring.")) (srecode-semantic-apply-tag-to-dict (srecode-semantic-tag (semantic-tag-name tag) :prime tag) diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index 6b8c3034a4c..4c1e030fceb 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -195,7 +195,7 @@ we can tell font lock about them.") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start-skip) - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (set (make-local-variable 'font-lock-defaults) '(srecode-font-lock-keywords nil ;; perform string/comment fontification diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d590b9ecf61..d4bec95ebad 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -517,6 +517,8 @@ command to run." This is a good place to put keybindings." :type 'hook :group 'cmuscheme) +(make-obsolete-variable 'cmuscheme-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'cmuscheme-load-hook) diff --git a/lisp/comint.el b/lisp/comint.el index bf376a0b81c..5c521ff0fdf 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3124,7 +3124,7 @@ See `comint-word'." "\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)" "\\|{\\(?1:[^{}]+\\)}\\)" (when (memq system-type '(ms-dos windows-nt)) - "\\|%\\(?1:[^\\\\/]*\\)%") + "\\|%\\(?1:[^\\/]*\\)%") (when comint-file-name-quote-list "\\|\\\\\\(.\\)"))) (qupos nil) diff --git a/lisp/desktop.el b/lisp/desktop.el index 7745b50b64c..de601a4de8c 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -344,7 +344,7 @@ to the value obtained by evaluating FORM." Each element is a regular expression. Buffers with a name matched by any of these won't be deleted." :version "23.3" ; added Warnings - bug#6336 - :type '(repeat string) + :type '(repeat regexp) :group 'desktop) ;;;###autoload diff --git a/lisp/dired.el b/lisp/dired.el index 689ad1fbfab..a4de51f6091 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -230,6 +230,8 @@ The target is used in the prompt for file copy, rename etc." You can customize key bindings or load extensions with this." :group 'dired :type 'hook) +(make-obsolete-variable 'dired-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom dired-mode-hook nil "Run at the very end of `dired-mode'." @@ -849,7 +851,6 @@ If a directory or nothing is found at point, return nil." (if (and file-name (not (file-directory-p file-name))) file-name))) -(put 'dired-mode 'grep-read-files 'dired-grep-read-files) ;;;###autoload (define-key ctl-x-map "d" 'dired) ;;;###autoload @@ -2149,6 +2150,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) +(defvar grep-read-files-function) ;; Autoload cookie needed by desktop.el ;;;###autoload (defun dired-mode (&optional dirname switches) @@ -2210,7 +2212,6 @@ Hooks (use \\[describe-variable] to see their documentation): `dired-before-readin-hook' `dired-after-readin-hook' `dired-mode-hook' - `dired-load-hook' Keybindings: \\{dired-mode-map}" @@ -2243,6 +2244,7 @@ Keybindings: (setq-local font-lock-defaults '(dired-font-lock-keywords t nil nil beginning-of-line)) (setq-local desktop-save-buffer 'dired-desktop-buffer-misc-data) + (setq-local grep-read-files-function #'dired-grep-read-files) (setq dired-switches-alist nil) (hack-dir-local-variables-non-file-buffer) ; before sorting (dired-sort-other dired-actual-switches t) @@ -3857,28 +3859,31 @@ With prefix argument, unmark or unflag these files." (if fn (backup-file-name-p fn)))) "backup file"))) -(defun dired-change-marks (&optional old new) +(defun dired-change-marks (old new) "Change all OLD marks to NEW marks. OLD and NEW are both characters used to mark files." + (declare (advertised-calling-convention '(old new) "28.1")) (interactive (let* ((cursor-in-echo-area t) (old (progn (message "Change (old mark): ") (read-char))) (new (progn (message "Change %c marks to (new mark): " old) (read-char)))) (list old new))) - (if (or (eq old ?\r) (eq new ?\r)) - (ding) - (let ((string (format "\n%c" old)) - (inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (while (search-forward string nil t) - (if (if (= old ?\s) - (save-match-data - (dired-get-filename 'no-dir t)) - t) - (subst-char-in-region (match-beginning 0) - (match-end 0) old new))))))) + (dolist (c (list new old)) + (if (or (not (char-displayable-p c)) + (eq c ?\r)) + (user-error "Invalid mark character: `%c'" c))) + (let ((string (format "\n%c" old)) + (inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (search-forward string nil t) + (if (if (= old ?\s) + (save-match-data + (dired-get-filename 'no-dir t)) + t) + (subst-char-in-region (match-beginning 0) + (match-end 0) old new)))))) (defun dired-unmark-all-marks () "Remove all marks from all files in the Dired buffer." diff --git a/lisp/disp-table.el b/lisp/disp-table.el index fe63573c0a3..2e88d350245 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -221,7 +221,7 @@ for a graphical frame." (defun make-glyph-code (char &optional face) "Return a glyph code representing char CHAR with face FACE." ;; Due to limitations on Emacs integer values, faces with - ;; face id greater that 512 are silently ignored. + ;; face id greater than 512 are silently ignored. (if (not face) char (let ((fid (face-id face))) diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 57940456660..2c42a191e0a 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -64,8 +64,8 @@ elided with an invisible overlay from the end of the line where the first match is found to the end of the match for the corresponding cdr." :group 'elide-head - :type '(alist :key-type (string :tag "Start regexp") - :value-type (string :tag "End regexp"))) + :type '(alist :key-type (regexp :tag "Start regexp") + :value-type (regexp :tag "End regexp"))) (defvar elide-head-overlay nil) (make-variable-buffer-local 'elide-head-overlay) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 850af93571f..b5d99e34518 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -149,9 +149,6 @@ ;; | ip -- 4 byte vector ;; | bits LEN -- List with bits set in LEN bytes. ;; -;; -- Note: 32 bit values may be limited by emacs' INTEGER -;; implementation limits. -;; ;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13) ;; and 0x1c 0x28 to (3 5 10 11 12). diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 90ab8911c39..fe0930c684b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -480,6 +480,13 @@ backwards))))) (cons fn (mapcar 'byte-optimize-form (cdr form))))) + ((eq fn 'while) + (unless (consp (cdr form)) + (byte-compile-warn "too few arguments for `while'")) + (cons fn + (cons (byte-optimize-form (cadr form) nil) + (byte-optimize-body (cddr form) t)))) + ((eq fn 'interactive) (byte-compile-warn "misplaced interactive spec: `%s'" (prin1-to-string form)) @@ -491,15 +498,12 @@ form) ((eq fn 'condition-case) - (if byte-compile--use-old-handlers - ;; Will be optimized later. - form - `(condition-case ,(nth 1 form) ;Not evaluated. - ,(byte-optimize-form (nth 2 form) for-effect) - ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) - (nthcdr 3 form))))) + `(condition-case ,(nth 1 form) ;Not evaluated. + ,(byte-optimize-form (nth 2 form) for-effect) + ,@(mapcar (lambda (clause) + `(,(car clause) + ,@(byte-optimize-body (cdr clause) for-effect))) + (nthcdr 3 form)))) ((eq fn 'unwind-protect) ;; the "protected" part of an unwind-protect is compiled (and thus @@ -514,12 +518,7 @@ ((eq fn 'catch) (cons fn (cons (byte-optimize-form (nth 1 form) nil) - (if byte-compile--use-old-handlers - ;; The body of a catch is compiled (and thus - ;; optimized) as a top-level form, so don't do it - ;; here. - (cdr (cdr form)) - (byte-optimize-body (cdr form) for-effect))))) + (byte-optimize-body (cdr form) for-effect)))) ((eq fn 'ignore) ;; Don't treat the args to `ignore' as being diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 73bbc2fe182..fce5e4aed6d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -719,14 +719,15 @@ otherwise pop it") "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") -(byte-defop 141 -1 byte-catch +(byte-defop 141 -1 byte-catch-OBSOLETE ; Not generated since Emacs 25. "for catch. Takes, on stack, the tag and an expression for the body") (byte-defop 142 -1 byte-unwind-protect "for unwind-protect. Takes, on stack, an expression for the unwind-action") ;; For condition-case. Takes, on stack, the variable to bind, ;; an expression for the body, and a list of clauses. -(byte-defop 143 -2 byte-condition-case) +;; Not generated since Emacs 25. +(byte-defop 143 -2 byte-condition-case-OBSOLETE) (byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE) (byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE) @@ -1201,7 +1202,7 @@ message buffer `default-directory'." byte-compile-last-warned-form)))) (insert (format "\nIn %s:\n" form))) (when level - (insert (format "%s%s" file pos)))) + (insert (format "%s%s " file pos)))) (setq byte-compile-last-logged-file byte-compile-current-file byte-compile-last-warned-form byte-compile-current-form) entry) @@ -2152,42 +2153,41 @@ With argument ARG, insert value in current buffer after the form." (when (< (point-max) (position-bytes (point-max))) (goto-char (point-min)) ;; Find the comment that describes the version condition. - (search-forward "\n;;; This file uses") - (narrow-to-region (line-beginning-position) (point-max)) - ;; Find the first line of ballast semicolons. - (search-forward ";;;;;;;;;;") - (beginning-of-line) - (narrow-to-region (point-min) (point)) - (let ((old-header-end (point)) - (minimum-version "23") - delta) - (delete-region (point-min) (point-max)) - (insert - ";;; This file contains utf-8 non-ASCII characters,\n" - ";;; and so cannot be loaded into Emacs 22 or earlier.\n" - ;; Have to check if emacs-version is bound so that this works - ;; in files loaded early in loadup.el. - "(and (boundp 'emacs-version)\n" - ;; If there is a name at the end of emacs-version, - ;; don't try to check the version number. - " (< (aref emacs-version (1- (length emacs-version))) ?A)\n" - (format " (string-lessp emacs-version \"%s\")\n" minimum-version) - ;; Because the header must fit in a fixed width, we cannot - ;; insert arbitrary-length file names (Bug#11585). - " (error \"`%s' was compiled for " - (format "Emacs %s or later\" #$))\n\n" minimum-version)) - ;; Now compensate for any change in size, to make sure all - ;; positions in the file remain valid. - (setq delta (- (point-max) old-header-end)) - (goto-char (point-max)) - (widen) - (delete-char delta)))) + (when (search-forward "\n;;; This file does not contain utf-8" nil t) + (narrow-to-region (line-beginning-position) (point-max)) + ;; Find the first line of ballast semicolons. + (search-forward ";;;;;;;;;;") + (beginning-of-line) + (narrow-to-region (point-min) (point)) + (let ((old-header-end (point)) + (minimum-version "23") + delta) + (delete-region (point-min) (point-max)) + (insert + ";;; This file contains utf-8 non-ASCII characters,\n" + ";;; and so cannot be loaded into Emacs 22 or earlier.\n" + ;; Have to check if emacs-version is bound so that this works + ;; in files loaded early in loadup.el. + "(and (boundp 'emacs-version)\n" + ;; If there is a name at the end of emacs-version, + ;; don't try to check the version number. + " (< (aref emacs-version (1- (length emacs-version))) ?A)\n" + (format " (string-lessp emacs-version \"%s\")\n" minimum-version) + ;; Because the header must fit in a fixed width, we cannot + ;; insert arbitrary-length file names (Bug#11585). + " (error \"`%s' was compiled for " + (format "Emacs %s or later\" #$))\n\n" minimum-version)) + ;; Now compensate for any change in size, to make sure all + ;; positions in the file remain valid. + (setq delta (- (point-max) old-header-end)) + (goto-char (point-max)) + (widen) + (delete-char delta))))) (defun byte-compile-insert-header (_filename outbuffer) "Insert a header at the start of OUTBUFFER. Call from the source buffer." - (let ((dynamic-docstrings byte-compile-dynamic-docstrings) - (dynamic byte-compile-dynamic) + (let ((dynamic byte-compile-dynamic) (optimize byte-optimize)) (with-current-buffer outbuffer (goto-char (point-min)) @@ -2213,11 +2213,7 @@ Call from the source buffer." ".\n" (if dynamic ";;; Function definitions are lazy-loaded.\n" "") - "\n;;; This file uses " - (if dynamic-docstrings - "dynamic docstrings, first added in Emacs 19.29" - "opcodes that do not exist in Emacs 18") - ".\n\n" + "\n" ;; Note that byte-compile-fix-header may change this. ";;; This file does not contain utf-8 non-ASCII characters,\n" ";;; and so can be loaded in Emacs versions earlier than 23.\n\n" @@ -2225,6 +2221,7 @@ Call from the source buffer." ;; can delete them so as to keep the buffer positions ;; constant for the actual compiled code. ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" + ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))) (defun byte-compile-output-file-form (form) @@ -3462,7 +3459,7 @@ for symbols generated by the byte compiler itself." (if (equal-including-properties (car elt) ,const) (setq result elt))) result) - (assq ,const byte-compile-constants)) + (assoc ,const byte-compile-constants #'eql)) (car (setq byte-compile-constants (cons (list ,const) byte-compile-constants))))) @@ -4529,96 +4526,25 @@ binding slots have been popped." ;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. ;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. -(defvar byte-compile--use-old-handlers nil - "If nil, use new byte codes introduced in Emacs-24.4.") - (defun byte-compile-catch (form) (byte-compile-form (car (cdr form))) - (if (not byte-compile--use-old-handlers) - (let ((endtag (byte-compile-make-tag))) - (byte-compile-goto 'byte-pushcatch endtag) - (byte-compile-body (cddr form) nil) - (byte-compile-out 'byte-pophandler) - (byte-compile-out-tag endtag)) - (pcase (cddr form) - (`(:fun-body ,f) - (byte-compile-form `(list 'funcall ,f))) - (body - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn body) byte-compile--for-effect)))) - (byte-compile-out 'byte-catch 0))) + (let ((endtag (byte-compile-make-tag))) + (byte-compile-goto 'byte-pushcatch endtag) + (byte-compile-body (cddr form) nil) + (byte-compile-out 'byte-pophandler) + (byte-compile-out-tag endtag))) (defun byte-compile-unwind-protect (form) (pcase (cddr form) (`(:fun-body ,f) - (byte-compile-form - (if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f))) + (byte-compile-form f)) (handlers - (if byte-compile--use-old-handlers - (byte-compile-push-constant - (byte-compile-top-level-body handlers t)) - (byte-compile-form `#'(lambda () ,@handlers))))) + (byte-compile-form `#'(lambda () ,@handlers)))) (byte-compile-out 'byte-unwind-protect 0) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) (defun byte-compile-condition-case (form) - (if byte-compile--use-old-handlers - (byte-compile-condition-case--old form) - (byte-compile-condition-case--new form))) - -(defun byte-compile-condition-case--old (form) - (let* ((var (nth 1 form)) - (fun-bodies (eq var :fun-body)) - (byte-compile-bound-variables - (if (and var (not fun-bodies)) - (cons var byte-compile-bound-variables) - byte-compile-bound-variables))) - (byte-compile-set-symbol-position 'condition-case) - (unless (symbolp var) - (byte-compile-warn - "`%s' is not a variable-name or nil (in condition-case)" var)) - (if fun-bodies (setq var (make-symbol "err"))) - (byte-compile-push-constant var) - (if fun-bodies - (byte-compile-form `(list 'funcall ,(nth 2 form))) - (byte-compile-push-constant - (byte-compile-top-level (nth 2 form) byte-compile--for-effect))) - (let ((compiled-clauses - (mapcar - (lambda (clause) - (let ((condition (car clause))) - (cond ((not (or (symbolp condition) - (and (listp condition) - (let ((ok t)) - (dolist (sym condition) - (if (not (symbolp sym)) - (setq ok nil))) - ok)))) - (byte-compile-warn - "`%S' is not a condition name or list of such (in condition-case)" - condition)) - ;; (not (or (eq condition 't) - ;; (and (stringp (get condition 'error-message)) - ;; (consp (get condition - ;; 'error-conditions))))) - ;; (byte-compile-warn - ;; "`%s' is not a known condition name - ;; (in condition-case)" - ;; condition)) - ) - (if fun-bodies - `(list ',condition (list 'funcall ,(cadr clause) ',var)) - (cons condition - (byte-compile-top-level-body - (cdr clause) byte-compile--for-effect))))) - (cdr (cdr (cdr form)))))) - (if fun-bodies - (byte-compile-form `(list ,@compiled-clauses)) - (byte-compile-push-constant compiled-clauses))) - (byte-compile-out 'byte-condition-case 0))) - -(defun byte-compile-condition-case--new (form) (let* ((var (nth 1 form)) (body (nth 2 form)) (depth byte-compile-depth) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index e2e59337d7b..351a097ad19 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -462,20 +462,7 @@ places where they originally did not directly appear." ;; and may be an invalid expression (e.g. ($# . 678)). (cdr forms))))) - ;condition-case - ((and `(condition-case ,var ,protected-form . ,handlers) - (guard byte-compile--use-old-handlers)) - (let ((newform (cconv--convert-function - () (list protected-form) env form))) - `(condition-case :fun-body ,newform - ,@(mapcar (lambda (handler) - (list (car handler) - (cconv--convert-function - (list (or var cconv--dummy-var)) - (cdr handler) env form))) - handlers)))) - - ; condition-case with new byte-codes. + ; condition-case (`(condition-case ,var ,protected-form . ,handlers) `(condition-case ,var ,(cconv-convert protected-form env extend) @@ -496,10 +483,8 @@ places where they originally did not directly appear." `((let ((,var (list ,var))) ,@body)))))) handlers)))) - (`(,(and head (or (and 'catch (guard byte-compile--use-old-handlers)) - 'unwind-protect)) - ,form . ,body) - `(,head ,(cconv-convert form env extend) + (`(unwind-protect ,form . ,body) + `(unwind-protect ,(cconv-convert form env extend) :fun-body ,(cconv--convert-function () body env form))) (`(setq . ,forms) ; setq special form @@ -718,15 +703,6 @@ and updates the data stored in ENV." (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote - ((and `(condition-case ,var ,protected-form . ,handlers) - (guard byte-compile--use-old-handlers)) - ;; FIXME: The bytecode for condition-case forces us to wrap the - ;; form and handlers in closures. - (cconv--analyze-function () (list protected-form) env form) - (dolist (handler handlers) - (cconv--analyze-function (if var (list var)) (cdr handler) - env form))) - (`(condition-case ,var ,protected-form . ,handlers) (cconv-analyze-form protected-form env) (when (and var (symbolp var) (byte-compile-not-lexical-var-p var)) @@ -741,9 +717,7 @@ and updates the data stored in ENV." form "variable")))) ;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind. - (`(,(or (and 'catch (guard byte-compile--use-old-handlers)) - 'unwind-protect) - ,form . ,body) + (`(unwind-protect ,form . ,body) (cconv-analyze-form form env) (cconv--analyze-function () body env form)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c4f69120ff7..4c2f58907de 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -1037,9 +1037,10 @@ For more details, see Info node `(cl)Loop Facility'. (defmacro cl--push-clause-loop-body (clause) "Apply CLAUSE to both `cl--loop-conditions' and `cl--loop-body'." - `(progn - (push ,clause cl--loop-conditions) - (push ,clause cl--loop-body))) + (macroexp-let2 nil sym clause + `(progn + (push ,sym cl--loop-conditions) + (push ,sym cl--loop-body)))) ;; Below is a complete spec for cl-loop, in several parts that correspond ;; to the syntax given in CLtL2. The specs do more than specify where @@ -1318,7 +1319,10 @@ For more details, see Info node `(cl)Loop Facility'. (nreverse cl--loop-conditions))) ,then ,var)) loop-for-steps)) - (push `(,var (if ,first-assign ,start ,then)) loop-for-sets)))) + (push (if (eq start then) + `(,var ,then) + `(,var (if ,first-assign ,start ,then))) + loop-for-sets)))) ((memq word '(across across-ref)) (let ((temp-vec (make-symbol "--cl-vec--")) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e6aed3a1202..85cc8c8e7ad 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1714,6 +1714,7 @@ contains a circular object." (cl-macrolet-body . edebug-match-cl-macrolet-body) (¬ . edebug-match-¬) (&key . edebug-match-&key) + (&error . edebug-match-&error) (place . edebug-match-place) (gate . edebug-match-gate) ;; (nil . edebug-match-nil) not this one - special case it. @@ -1847,6 +1848,15 @@ contains a circular object." (car (cdr pair)))) specs)))) +(defun edebug-match-&error (cursor specs) + ;; Signal an error, using the following string in the spec as argument. + (let ((error-string (car specs)) + (edebug-error-point (edebug-before-offset cursor))) + (goto-char edebug-error-point) + (error "%s" + (if (stringp error-string) + error-string + "String expected after &error in edebug-spec")))) (defun edebug-match-gate (_cursor) ;; Simply set the gate to prevent backtracking at this level. @@ -2216,6 +2226,8 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'." (def-edebug-spec nested-backquote-form (&or + ("`" &error "Triply nested backquotes (without commas \"between\" them) \ +are too difficult to instrument") ;; Allow instrumentation of any , or ,@ contained within the (\, ...) or ;; (\,@ ...) matched on the next line. ([&or "," ",@"] backquote-form) @@ -3708,7 +3720,6 @@ Return the result of the last expression." (prin1-to-string edebug-arg)) (cdr value) ", "))) -(defvar print-readably) ; defined by lemacs ;; Alternatively, we could change the definition of ;; edebug-safe-prin1-to-string to only use these if defined. @@ -3716,8 +3727,7 @@ Return the result of the last expression." (let ((print-escape-newlines t) (print-length (or edebug-print-length print-length)) (print-level (or edebug-print-level print-level)) - (print-circle (or edebug-print-circle print-circle)) - (print-readably nil)) ; lemacs uses this. + (print-circle (or edebug-print-circle print-circle))) (edebug-prin1-to-string value))) (defun edebug-compute-previous-result (previous-value) @@ -4520,17 +4530,6 @@ With prefix argument, make it a temporary breakpoint." (edebug-modify-breakpoint t condition arg)) (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) - -;;; Autoloading of Edebug accessories - -;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu -(defun edebug--require-cl-read () - (require 'edebug-cl-read)) - -(if (featurep 'cl-read) - (add-hook 'edebug-setup-hook #'edebug--require-cl-read) - ;; The following causes edebug-cl-read to be loaded when you load cl-read.el. - (add-hook 'cl-read-load-hooks #'edebug--require-cl-read)) ;;; Finalize Loading @@ -4566,7 +4565,6 @@ With prefix argument, make it a temporary breakpoint." (run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug))))) (remove-hook 'called-interactively-p-functions #'edebug--called-interactively-skip) - (remove-hook 'cl-read-load-hooks #'edebug--require-cl-read) (edebug-uninstall-read-eval-functions) ;; Continue standard unloading. nil) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index dda90373069..59af7e12d21 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -278,14 +278,7 @@ are not abstract." (if eieio-class-speedbar-key-map nil - (if (not (featurep 'speedbar)) - (add-hook 'speedbar-load-hook (lambda () - (eieio-class-speedbar-make-map) - (speedbar-add-expansion-list - '("EIEIO" - eieio-class-speedbar-menu - eieio-class-speedbar-key-map - eieio-class-speedbar)))) + (with-eval-after-load 'speedbar (eieio-class-speedbar-make-map) (speedbar-add-expansion-list '("EIEIO" eieio-class-speedbar-menu diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index c11608da5d8..5c6e0e516d1 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -140,11 +140,7 @@ MENU-VAR is the symbol containing an easymenu compatible menu part to use. MODENAME is a string used to identify this browser mode. FETCHER is a generic function used to fetch the base object list used when creating the speedbar display." - (if (not (featurep 'speedbar)) - (add-hook 'speedbar-load-hook - (list 'lambda nil - (list 'eieio-speedbar-create-engine - map-fn map-var menu-var modename fetcher))) + (with-eval-after-load 'speedbar (eieio-speedbar-create-engine map-fn map-var menu-var modename fetcher))) (defun eieio-speedbar-create-engine (map-fn map-var menu-var modename fetcher) diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 8a9b01d580f..27ed29925b3 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -155,7 +155,7 @@ DYNAMIC-VAR bound to STATIC-VAR." (defun cps--add-state (kind body) "Create a new CPS state with body BODY and return the state's name." (declare (indent 1)) - (let* ((state (cps--gensym "cps-state-%s-" kind))) + (let ((state (cps--gensym "cps-state-%s-" kind))) (push (list state body cps--cleanup-function) cps--states) (push state cps--bindings) state)) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index ceb9b6bea5f..0d57bc16a3a 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -485,7 +485,18 @@ absent, return nil." (lm-with-file file (let ((start (lm-commentary-start))) (when start - (buffer-substring-no-properties start (lm-commentary-end)))))) + (replace-regexp-in-string ; Get rid of... + "[[:blank:]]*$" "" ; trailing white-space + (replace-regexp-in-string + (format "%s\\|%s\\|%s" + ;; commentary header + (concat "^;;;[[:blank:]]*\\(" + lm-commentary-header + "\\):[[:blank:]\n]*") + "^;;[[:blank:]]*" ; double semicolon prefix + "[[:blank:]\n]*\\'") ; trailing new-lines + "" (buffer-substring-no-properties + start (lm-commentary-end)))))))) (defun lm-homepage (&optional file) "Return the homepage in file FILE, or current buffer if FILE is nil." diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fbbd389bf96..3b0f5493eeb 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -456,7 +456,7 @@ This will generate compile-time constants from BINDINGS." (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. - (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>") + (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>") . font-lock-type-face) ;; ELisp regexp grouping constructs (,(lambda (bound) @@ -511,7 +511,7 @@ This will generate compile-time constants from BINDINGS." (,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>") (0 font-lock-builtin-face)) ;; ELisp and CLisp `&' keywords as types. - (,(concat "\\_<\\&" lisp-mode-symbol-regexp "\\_>") + (,(concat "\\_<&" lisp-mode-symbol-regexp "\\_>") . font-lock-type-face) ;; This is too general -- rms. ;; A user complained that he has functions whose names start with `do' @@ -747,9 +747,10 @@ Blank lines separate paragraphs. Semicolons start comments. Note that `run-lisp' may be used either to start an inferior Lisp job or to switch back to an existing one." (lisp-mode-variables nil t) + (setq-local lisp-indent-function 'common-lisp-indent-function) (setq-local find-tag-default-function 'lisp-find-tag-default) (setq-local comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") (setq imenu-case-fold-search t)) (defun lisp-find-tag-default () diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 67f5b3cf24e..9c23344baca 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 2.0 +;; Version: 2.1 ;; Package-Requires: ((emacs "25")) ;; Package: map @@ -56,8 +56,10 @@ evaluated and searched for in the map. The match fails if for any KEY found in the map, the corresponding PAT doesn't match the value associated to the KEY. -Each element can also be a SYMBOL, which is an abbreviation of a (KEY -PAT) tuple of the form (\\='SYMBOL SYMBOL). +Each element can also be a SYMBOL, which is an abbreviation of +a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL +is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL), +useful for binding plist values. Keys in ARGS not found in the map are ignored, and the match doesn't fail." @@ -486,9 +488,12 @@ Example: (defun map--make-pcase-bindings (args) "Return a list of pcase bindings from ARGS to the elements of a map." (seq-map (lambda (elt) - (if (consp elt) - `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)) - `(app (pcase--flip map-elt ',elt) ,elt))) + (cond ((consp elt) + `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt))) + ((keywordp elt) + (let ((var (intern (substring (symbol-name elt) 1)))) + `(app (pcase--flip map-elt ,elt) ,var))) + (t `(app (pcase--flip map-elt ',elt) ,elt)))) args)) (defun map--make-pcase-patterns (args) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 10ce19525a0..c91ee445e13 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -926,7 +926,6 @@ untar into a directory named DIR; otherwise, signal an error." (if (> (length file-list) 1) 'tar 'single)))) ('tar (make-directory package-user-dir t) - ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer dirname))) ('single @@ -2377,18 +2376,9 @@ The description is read from the installed package files." result ;; Look for Commentary header. - (let ((mainsrcfile (expand-file-name (format "%s.el" (package-desc-name desc)) - srcdir))) - (when (file-readable-p mainsrcfile) - (with-temp-buffer - (insert (or (lm-commentary mainsrcfile) "")) - (goto-char (point-min)) - (when (re-search-forward "^;;; Commentary:\n" nil t) - (replace-match "")) - (while (re-search-forward "^\\(;+ ?\\)" nil t) - (replace-match "")) - (buffer-string)))) - ))) + (lm-commentary (expand-file-name + (format "%s.el" (package-desc-name desc)) srcdir)) + ""))) (defun describe-package-1 (pkg) "Insert the package description for PKG. @@ -2583,16 +2573,10 @@ Helper function for `describe-package'." (if built-in ;; For built-in packages, get the description from the ;; Commentary header. - (let ((fn (locate-file (format "%s.el" name) load-path - load-file-rep-suffixes)) - (opoint (point))) - (insert (or (lm-commentary fn) "")) - (save-excursion - (goto-char opoint) - (when (re-search-forward "^;;; Commentary:\n" nil t) - (replace-match "")) - (while (re-search-forward "^\\(;+ ?\\)" nil t) - (replace-match "")))) + (insert (or (lm-commentary (locate-file (format "%s.el" name) + load-path + load-file-rep-suffixes)) + "")) (if (package-installed-p desc) ;; For installed packages, get the description from the @@ -2695,15 +2679,18 @@ either a full name or nil, and EMAIL is a valid email address." (define-key map "i" 'package-menu-mark-install) (define-key map "U" 'package-menu-mark-upgrades) (define-key map "r" 'revert-buffer) - (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) - (define-key map (kbd "/ n") 'package-menu-filter-by-name) - (define-key map (kbd "/ /") 'package-menu-clear-filter) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) (define-key map "h" 'package-menu-quick-help) (define-key map "H" #'package-menu-hide-package) (define-key map "?" 'package-menu-describe-package) (define-key map "(" #'package-menu-toggle-hiding) + (define-key map (kbd "/ /") 'package-menu-clear-filter) + (define-key map (kbd "/ a") 'package-menu-filter-by-archive) + (define-key map (kbd "/ k") 'package-menu-filter-by-keyword) + (define-key map (kbd "/ n") 'package-menu-filter-by-name) + (define-key map (kbd "/ s") 'package-menu-filter-by-status) + (define-key map (kbd "/ v") 'package-menu-filter-by-version) map) "Local keymap for `package-menu-mode' buffers.") @@ -2729,8 +2716,11 @@ either a full name or nil, and EMAIL is a valid email address." "--" ("Filter Packages" + ["Filter by Archive" package-menu-filter-by-archive :help "Filter packages by archive"] ["Filter by Keyword" package-menu-filter-by-keyword :help "Filter packages by keyword"] ["Filter by Name" package-menu-filter-by-name :help "Filter packages by name"] + ["Filter by Status" package-menu-filter-by-status :help "Filter packages by status"] + ["Filter by Version" package-menu-filter-by-version :help "Filter packages by version"] ["Clear Filter" package-menu-clear-filter :help "Clear package list filter"]) ["Hide by Regexp" package-menu-hide-package :help "Hide all packages matching a regexp"] @@ -3036,22 +3026,31 @@ When none are given, the package matches." found) t)) -(defun package-menu--generate (remember-pos packages &optional keywords) - "Populate the Package Menu. +(defun package-menu--display (remember-pos suffix) + "Display the Package Menu. If REMEMBER-POS is non-nil, keep point on the same entry. + +If SUFFIX is non-nil, append that to \"Package\" for the first +column in the header line." + (setf (car (aref tabulated-list-format 0)) + (if suffix + (concat "Package[" suffix "]") + "Package")) + (tabulated-list-init-header) + (tabulated-list-print remember-pos)) + +(defun package-menu--generate (remember-pos &optional packages keywords) + "Populate and display the Package Menu. PACKAGES should be t, which means to display all known packages, or a list of package names (symbols) to display. With KEYWORDS given, only packages with those keywords are shown." (package-menu--refresh packages keywords) - (setf (car (aref tabulated-list-format 0)) - (if keywords - (let ((filters (mapconcat #'identity keywords ","))) - (concat "Package[" filters "]")) - "Package")) - (tabulated-list-init-header) - (tabulated-list-print remember-pos)) + (package-menu--display remember-pos + (when keywords + (let ((filters (mapconcat #'identity keywords ","))) + (concat "Package[" filters "]"))))) (defun package-menu--print-info (pkg) "Return a package entry suitable for `tabulated-list-entries'. @@ -3174,12 +3173,15 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (defun package-menu--refresh-contents (&optional _arg _noconfirm) "In Package Menu, download the Emacs Lisp package archive. Fetch the contents of each archive specified in -`package-archives', and then refresh the package menu. +`package-archives', and then refresh the package menu. Signal a +user-error if there is already a refresh running asynchronously. `package-menu-mode' sets `revert-buffer-function' to this function. The args ARG and NOCONFIRM, passed from `revert-buffer', are ignored." (package--ensure-package-menu-mode) + (when (and package-menu-async package--downloads-in-progress) + (user-error "Package refresh is already in progress, please wait...")) (setq package-menu--old-archive-contents package-archive-contents) (setq package-menu--new-package-list nil) (package-refresh-contents package-menu-async)) @@ -3687,45 +3689,160 @@ shown." (select-window win) (switch-to-buffer buf)))) +(defun package-menu--filter-by (predicate suffix) + "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header. +PREDICATE is a function which will be called with one argument, a +`package-desc' object, and returns t if that object should be +listed in the Package Menu. + +SUFFIX is passed on to `package-menu--display' and is added to +the header line of the first column." + ;; Update `tabulated-list-entries' so that it contains all + ;; packages before searching. + (package-menu--refresh t nil) + (let (found-entries) + (dolist (entry tabulated-list-entries) + (when (funcall predicate (car entry)) + (push entry found-entries))) + (if found-entries + (progn + (setq tabulated-list-entries found-entries) + (package-menu--display t suffix)) + (user-error "No packages found")))) + +(defun package-menu-filter-by-archive (archive) + "Filter the \"*Packages*\" buffer by ARCHIVE. +Display only packages from package archive ARCHIVE. + +When called interactively, prompt for ARCHIVE, which can be a +comma-separated string. If ARCHIVE is empty, show all packages. + +When called from Lisp, ARCHIVE can be a string or a list of +strings. If ARCHIVE is nil or the empty string, show all +packages." + (interactive (list (completing-read-multiple + "Filter by archive (comma separated): " + (mapcar #'car package-archives)))) + (package--ensure-package-menu-mode) + (let ((re (if (listp archive) + (regexp-opt archive) + archive))) + (package-menu--filter-by (lambda (pkg-desc) + (let ((pkg-archive (package-desc-archive pkg-desc))) + (and pkg-archive + (string-match-p re pkg-archive)))) + (concat "archive:" (if (listp archive) + (string-join archive ",") + archive))))) + (defun package-menu-filter-by-keyword (keyword) "Filter the \"*Packages*\" buffer by KEYWORD. -Show only those items that relate to the specified KEYWORD. - -KEYWORD can be a string or a list of strings. If it is a list, a -package will be displayed if it matches any of the keywords. -Interactively, it is a list of strings separated by commas. - -KEYWORD can also be used to filter by status or archive name by -using keywords like \"arc:gnu\" and \"status:available\". -Statuses available include \"incompat\", \"available\", -\"built-in\" and \"installed\"." - (interactive - (list (completing-read-multiple - "Keywords (comma separated): " (package-all-keywords)))) +Display only packages with specified KEYWORD. + +When called interactively, prompt for KEYWORD, which can be a +comma-separated string. If KEYWORD is empty, show all packages. + +When called from Lisp, KEYWORD can be a string or a list of +strings. If KEYWORD is nil or the empty string, show all +packages." + (interactive (list (completing-read-multiple + "Keywords (comma separated): " + (package-all-keywords)))) + (when (stringp keyword) + (setq keyword (list keyword))) (package--ensure-package-menu-mode) - (package-show-package-list t (if (stringp keyword) - (list keyword) - keyword))) + (if (not keyword) + (package-menu--generate t t) + (package-menu--filter-by (lambda (pkg-desc) + (package--has-keyword-p pkg-desc keyword)) + (concat "keyword:" (string-join keyword ","))))) (defun package-menu-filter-by-name (name) - "Filter the \"*Packages*\" buffer by NAME. -Show only those items whose name matches the regular expression -NAME. If NAME is nil or the empty string, show all packages." - (interactive (list (read-from-minibuffer "Filter by name (regexp): "))) + "Filter the \"*Packages*\" buffer by NAME regexp. +Display only packages with name that matches regexp NAME. + +When called interactively, prompt for NAME. + +If NAME is nil or the empty string, show all packages." + (interactive (list (read-regexp "Filter by name (regexp)"))) (package--ensure-package-menu-mode) (if (or (not name) (string-empty-p name)) - (package-show-package-list t nil) - ;; Update `tabulated-list-entries' so that it contains all - ;; packages before searching. - (package-menu--refresh t nil) - (let (matched) - (dolist (entry tabulated-list-entries) - (let* ((pkg-name (package-desc-name (car entry)))) - (when (string-match name (symbol-name pkg-name)) - (push pkg-name matched)))) - (if matched - (package-show-package-list matched nil) - (user-error "No packages found"))))) + (package-menu--generate t t) + (package-menu--filter-by (lambda (pkg-desc) + (string-match-p name (symbol-name + (package-desc-name pkg-desc)))) + (format "name:%s" name)))) + +(defun package-menu-filter-by-status (status) + "Filter the \"*Packages*\" buffer by STATUS. +Display only packages with specified STATUS. + +When called interactively, prompt for STATUS, which can be a +comma-separated string. If STATUS is empty, show all packages. + +When called from Lisp, STATUS can be a string or a list of +strings. If STATUS is nil or the empty string, show all +packages." + (interactive (list (completing-read "Filter by status: " + '("avail-obso" + "available" + "built-in" + "dependency" + "disabled" + "external" + "held" + "incompat" + "installed" + "new" + "unsigned")))) + (package--ensure-package-menu-mode) + (if (or (not status) (string-empty-p status)) + (package-menu--generate t t) + (package-menu--filter-by (lambda (pkg-desc) + (string-match-p status (package-desc-status pkg-desc))) + (format "status:%s" status)))) + +(defun package-menu-filter-by-version (version predicate) + "Filter the \"*Packages*\" buffer by VERSION and PREDICATE. +Display only packages with a matching version. + +When called interactively, prompt for one of the qualifiers `<', +`>' or `=', and a package version. Show only packages that has a +lower (`<'), equal (`=') or higher (`>') version than the +specified one. + +When called from Lisp, VERSION should be a version string and +PREDICATE should be the symbol `=', `<' or `>'. + +If VERSION is nil or the empty string, show all packages." + (interactive (let ((choice (intern + (char-to-string + (read-char-choice + "Filter by version? [Type =, <, > or q] " + '(?< ?> ?= ?q)))))) + (if (eq choice 'q) + '(quit nil) + (list (read-from-minibuffer + (concat "Filter by version (" + (pcase choice + ('= "= equal to") + ('< "< less than") + ('> "> greater than")) + "): ")) + choice)))) + (unless (equal predicate 'quit) + (if (or (not version) (string-empty-p version)) + (package-menu--generate t t) + (package-menu--filter-by + (let ((fun (pcase predicate + ('= 'version-list-=) + ('< 'version-list-<) + ('> '(lambda (a b) (not (version-list-<= a b)))) + (_ (error "Unknown predicate: %s" predicate)))) + (ver (version-to-list version))) + (lambda (pkg-desc) + (funcall fun (package-desc-version pkg-desc) ver))) + (format "versions:%s%s" predicate version))))) (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." @@ -3774,6 +3891,7 @@ The return value is a string (or nil in case we can't find it)." (or (lm-header "package-version") (lm-header "version"))))))))) + ;;;; Quickstart: precompute activation actions for faster start up. ;; Activating packages via `package-initialize' is costly: for N installed diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 501cc3a29e0..b13f609f882 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -547,10 +547,10 @@ Return the column number after insertion." ;; Don't truncate to `width' if the next column is align-right ;; and has some space left, truncate to `available-space' instead. (when (and not-last-col - (> label-width available-space) - (setq label (truncate-string-to-width - label available-space nil nil t t) - label-width available-space))) + (> label-width available-space)) + (setq label (truncate-string-to-width + label available-space nil nil t t) + label-width available-space)) (setq label (bidi-string-mark-left-to-right label)) (when (and right-align (> width label-width)) (let ((shift (- width label-width))) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 511c68f24a7..6c4afe519f2 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -922,6 +922,8 @@ Should be set in `viper-custom-file-name'." "Hooks run just after loading Viper." :type 'hook :group 'viper-hooks) +(make-obsolete-variable 'viper-load-hook + "use `with-eval-after-load' instead." "28.1") (defun viper-restore-cursor-type () (condition-case nil diff --git a/lisp/epa.el b/lisp/epa.el index 47c177e6cd5..8ec42187358 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -361,7 +361,10 @@ If ARG is non-nil, mark the key." 'start-open t 'end-open t))))) -(defun epa--list-keys (name secret) +(defun epa--list-keys (name secret &optional doc) + "NAME specifies which key to list. +SECRET says list data on the secret key (default, the public key). +DOC is documentation text to insert at the start." (unless (and epa-keys-buffer (buffer-live-p epa-keys-buffer)) (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) @@ -371,13 +374,28 @@ If ARG is non-nil, mark the key." buffer-read-only (point (point-min)) (context (epg-make-context epa-protocol))) + + ;; Find the end of the documentation text at the start. + ;; Set POINT to where it ends, or nil if ends at eob. (unless (get-text-property point 'epa-list-keys) (setq point (next-single-property-change point 'epa-list-keys))) + + ;; If caller specified documentation text for that, replace the old + ;; documentation text (if any) with what was specified. + ;; Otherwise, preserve whatever intro text is present. + (when doc + (if (or point (not (eobp))) + (delete-region (point-min) point)) + (insert doc) + (setq point (point))) + + ;; Now delete the key description text, if any. (when point (delete-region point (or (next-single-property-change point 'epa-list-keys) (point-max))) (goto-char point)) + (epa--insert-keys (epg-list-keys context name secret)) (widget-setup) (set-keymap-parent (current-local-map) widget-keymap)) @@ -396,7 +414,13 @@ If ARG is non-nil, mark the key." (car epa-list-keys-arguments))))) (list (if (equal name "") nil name))) (list nil))) - (epa--list-keys name nil)) + (epa--list-keys name nil + "The letters at the start of a line have these meanings. +e expired key. n never trust. m trust marginally. u trust ultimately. +f trust fully (keys you have signed, usually). +q trust status questionable. - trust status unspecified. + See GPG documentaion for more explanation. +\n")) ;;;###autoload (defun epa-list-secret-keys (&optional name) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index ffa72204f43..b1a829cde7a 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -375,7 +375,7 @@ Example: If you know that the channel #linux-ru uses the coding-system `cyrillic-koi8', then add (\"#linux-ru\" . cyrillic-koi8) to the alist." :group 'erc-server - :type '(repeat (cons (string :tag "Target") + :type '(repeat (cons (regexp :tag "Target") coding-system))) (defcustom erc-server-connect-function #'erc-open-network-stream diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 7e58469ddae..a2d58e927e9 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -34,7 +34,7 @@ (defcustom erc-ezb-regexp "^ezbounce!srv$" "Regexp used by the EZBouncer to identify itself to the user." :group 'erc-ezbounce - :type 'string) + :type 'regexp) (defcustom erc-ezb-login-alist '() "Alist of logins suitable for the server we're connecting to. diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 0fde3bf7cc3..1c0635c528c 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -90,9 +90,8 @@ nil - Do not sort users" "Additional menu-items to add to speedbar frame.") ;; Make sure our special speedbar major mode is loaded -(if (featurep 'speedbar) - (erc-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'erc-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (erc-install-speedbar-variables)) ;;; ERC hierarchy display method ;;;###autoload diff --git a/lisp/expand.el b/lisp/expand.el index 1417c90fdb4..77e4fc2657c 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -55,10 +55,8 @@ ;; ;; you can also init some post-process hooks : ;; -;; (add-hook 'expand-load-hook -;; (lambda () -;; (add-hook 'expand-expand-hook 'indent-according-to-mode) -;; (add-hook 'expand-jump-hook 'indent-according-to-mode))) +;; (add-hook 'expand-expand-hook 'indent-according-to-mode) +;; (add-hook 'expand-jump-hook 'indent-according-to-mode) ;; ;; Remarks: ;; @@ -78,6 +76,8 @@ "Hooks run when `expand.el' is loaded." :type 'hook :group 'expand) +(make-obsolete-variable 'expand-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom expand-expand-hook nil "Hooks run when an abbrev made by `expand-add-abbrevs' is expanded." diff --git a/lisp/ffap.el b/lisp/ffap.el index 66ef0824d8a..ead79b45c0e 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -1080,7 +1080,7 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered." ;; Slightly controversial decisions: ;; * strip trailing "@", ":" and enclosing "{"/"}". ;; * no commas (good for latex) - (file "--:\\\\${}+<>@-Z_[:alpha:]~*?" "{<@" "@>;.,!:}") + (file "--:\\\\${}+<>@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}") ;; An url, or maybe an email/news message-id: (url "--:=&?$+@-Z_[:alpha:]~#,%;*()!'" "^[0-9a-zA-Z]" ":;.,!?") ;; Find a string that does *not* contain a colon: diff --git a/lisp/files.el b/lisp/files.el index 38536a92da7..683f4a8ce7c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -405,7 +405,7 @@ editing a remote file. On MS-DOS filesystems without long names this variable is always ignored." :group 'auto-save - :type '(repeat (list (string :tag "Regexp") (string :tag "Replacement") + :type '(repeat (list (regexp :tag "Regexp") (string :tag "Replacement") (boolean :tag "Uniquify"))) :initialize 'custom-initialize-delay :version "21.1") diff --git a/lisp/filesets.el b/lisp/filesets.el index 9834bcf0587..1ec0d24b539 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -1645,10 +1645,10 @@ Replace <file-name> or <<file-name>> with filename." (dolist (this args txt) (setq txt (concat txt + (if (equal txt "") "" " ") (filesets-run-cmd--repl-fn this (lambda (this) - (if (equal txt "") "" " ") (format "%s" this)))))))) (cmd (concat fn " " args))) (filesets-cmd-show-result diff --git a/lisp/finder.el b/lisp/finder.el index 96359b0b4fe..dc14b27a753 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -394,13 +394,6 @@ FILE should be in a form suitable for passing to `locate-library'." (erase-buffer) (insert str) (goto-char (point-min)) - (delete-blank-lines) - (goto-char (point-max)) - (delete-blank-lines) - (goto-char (point-min)) - (while (re-search-forward "^;+ ?" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) (if (locate-library (match-string 1)) (make-text-button (match-beginning 1) (match-end 1) diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index 82dbbab5e0d..647f643c962 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -266,21 +266,21 @@ "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, " "Regular expression matching the beginning of an attribution line that should be cut off." :version "22.1" - :type 'string + :type 'regexp :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-verb-regexp "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió" "Regular expression matching the verb used in an attribution line." :version "22.1" - :type 'string + :type 'regexp :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-deuglify-attrib-end-regexp ": *\\|\\.\\.\\." "Regular expression matching the end of an attribution line." :version "22.1" - :type 'string + :type 'regexp :group 'gnus-outlook-deuglify) (defcustom gnus-outlook-display-hook nil @@ -403,9 +403,9 @@ NODISPLAY is non-nil, don't redisplay the article buffer." (gnus-with-article-buffer (article-goto-body) (when (re-search-forward - (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n" + (concat "^[" cite-marks " \t]*--*[^-]+ [^-]+--*\\s *\n" "[^\n:]+:[ \t]*\\([^\n]+\\)\n" - "\\([^\n:]+:[ \t]*[^\n]+\n\\)+") + "\\([^\n:]+:[^\n]+\n\\)+") nil t) (gnus-kill-all-overlays) (replace-match "\\1 wrote:\n") diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 9f22b7df0ff..80bf21bb443 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -799,7 +799,7 @@ be a select method." (let ((gnus-command-method method) (gnus-agent nil)) (when (file-exists-p (gnus-agent-lib-file "flags")) - (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) + (set-buffer (gnus-get-buffer-create " *Gnus Agent flag synchronize*")) (erase-buffer) (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) (cond ((null gnus-plugged) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index ea4af2df0c4..1b00bbbc69c 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -242,7 +242,7 @@ So the cdr of each bookmark is an alist too.") (save-window-excursion ;; Avoid warnings? ;; (message "Saving Gnus bookmarks to file %s..." gnus-bookmark-default-file) - (set-buffer (get-buffer-create " *Gnus bookmarks*")) + (set-buffer (gnus-get-buffer-create " *Gnus bookmarks*")) (erase-buffer) (gnus-bookmark-insert-file-format-version-stamp) (pp gnus-bookmark-alist (current-buffer)) @@ -357,8 +357,8 @@ deletion, or > if it is flagged for displaying." (interactive) (gnus-bookmark-maybe-load-default-file) (if (called-interactively-p 'any) - (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*")) - (set-buffer (get-buffer-create "*Gnus Bookmark List*"))) + (switch-to-buffer (gnus-get-buffer-create "*Gnus Bookmark List*")) + (set-buffer (gnus-get-buffer-create "*Gnus Bookmark List*"))) (let ((inhibit-read-only t) alist name start end) (erase-buffer) @@ -648,7 +648,7 @@ reposition and try again, else return nil." (details gnus-bookmark-bookmark-details) detail) (save-excursion - (pop-to-buffer (get-buffer-create "*Gnus Bookmark Annotation*") t) + (pop-to-buffer (gnus-get-buffer-create "*Gnus Bookmark Annotation*") t) (erase-buffer) (while details (setq detail (pop details)) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index cecfaef2f4f..4d8764bacca 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -243,10 +243,10 @@ Use old data if FORCE-OLDER is not nil." (when (or (not gnus-cloud-interactive) (gnus-y-or-n-p (format "%s has older different info in the cloud as of %s, update it here? " - group date)))) - (gnus-message 2 "Installing cloud update of group %s" group) - (gnus-set-info group contents) - (gnus-group-update-group group))) + group date))) + (gnus-message 2 "Installing cloud update of group %s" group) + (gnus-set-info group contents) + (gnus-group-update-group group)))) (gnus-error 1 "Sorry, group %s is not subscribed" group)) (gnus-error 1 "Sorry, could not update newsrc for group %s (invalid data %S)" group elem)))) diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 1b25d247389..3a9bf2a7e8f 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -248,7 +248,7 @@ If DONT-POP is nil, display the buffer after setting it up." (let ((article narticle)) (message-mail nil nil nil nil (if dont-pop - (lambda (buf) (set-buffer (get-buffer-create buf))))) + (lambda (buf) (set-buffer (gnus-get-buffer-create buf))))) (let ((inhibit-read-only t)) (erase-buffer)) (if (not (gnus-request-restore-buffer article group)) diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 33cbf4a54a9..c95449762e4 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -40,7 +40,7 @@ "Regexp to match faces in `gnus-x-face-directory' to be omitted." :version "25.1" :group 'gnus-fun - :type '(choice (const nil) string)) + :type '(choice (const nil) regexp)) (defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) "Directory where Face PNG files are stored." @@ -52,7 +52,7 @@ "Regexp to match faces in `gnus-face-directory' to be omitted." :version "25.1" :group 'gnus-fun - :type '(choice (const nil) string)) + :type '(choice (const nil) regexp)) (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" "Command for converting a PBM to an X-Face." diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index b89f040b435..da7db589ec3 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -3761,10 +3761,10 @@ group line." (newsrc ;; Toggle subscription flag. (gnus-group-change-level - newsrc (if level level (if (<= (gnus-info-level (nth 1 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) + newsrc (or level (if (<= (gnus-info-level (nth 1 newsrc)) + gnus-level-subscribed) + (1+ gnus-level-subscribed) + gnus-level-default-subscribed))) (unless silent (gnus-group-update-group group))) ((and (stringp group) @@ -3773,7 +3773,7 @@ group line." ;; Add new newsgroup. (gnus-group-change-level group - (if level level gnus-level-default-subscribed) + (or level gnus-level-default-subscribed) (or (and (member group gnus-zombie-list) gnus-level-zombie) gnus-level-killed) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index ee556a32080..305e17fd8fc 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -814,7 +814,7 @@ These will be used to retrieve the RSVP information from ical events." (let ((subject (concat (capitalize (symbol-name status)) ": " (gnus-icalendar-event:summary event)))) - (with-current-buffer (get-buffer-create gnus-icalendar-reply-bufname) + (with-current-buffer (gnus-get-buffer-create gnus-icalendar-reply-bufname) (delete-region (point-min) (point-max)) (insert reply) (fold-icalendar-buffer) diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index c304f575d92..60ebc07c343 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -253,7 +253,7 @@ If it is down, start it up (again)." (defun gnus-backend-trace (type form) (when gnus-backend-trace - (with-current-buffer (get-buffer-create "*gnus trace*") + (with-current-buffer (gnus-get-buffer-create "*gnus trace*") (buffer-disable-undo) (goto-char (point-max)) (insert (format-time-string "%H:%M:%S") diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index d58bd7a73b5..095e05408d6 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -309,7 +309,7 @@ The following commands are available: ;; `gnus-server-buffer' selected as the current buffer, but not always (I ;; bumped into it when starting from a dedicated *Group* frame, and ;; gnus-configure-windows opened *Server* into its own dedicated frame). - (with-current-buffer (get-buffer-create gnus-server-buffer) + (with-current-buffer (gnus-get-buffer-create gnus-server-buffer) (gnus-server-mode) (gnus-server-prepare))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 61319266ced..873923e6c57 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1256,19 +1256,19 @@ INFO-LIST), otherwise it's a list in the format of the `gnus-newsrc-hashtb' entries. LEVEL is the new level of the group, OLDLEVEL is the old level and PREVIOUS is the group (a string name) to insert this group before." - (let (group info active num) - ;; Glean what info we can from the arguments. - (if (consp entry) - (setq group (if fromkilled (nth 1 entry) (car (nth 1 entry)))) - (setq group entry)) + ;; Glean what info we can from the arguments. + (let ((group (if (consp entry) + (if fromkilled (nth 1 entry) (car (nth 1 entry))) + entry)) + info active num) (when (and (stringp entry) oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-group-entry entry))) - (if (and (not oldlevel) - (consp entry)) - (setq oldlevel (gnus-info-level (nth 1 entry))) - (setq oldlevel (or oldlevel gnus-level-killed))) + (setq oldlevel (if (and (not oldlevel) + (consp entry)) + (gnus-info-level (nth 1 entry)) + (or oldlevel gnus-level-killed))) ;; This table is used for completion, so put a dummy entry there. (unless (gethash group gnus-active-hashtb) @@ -2812,7 +2812,7 @@ values from `gnus-newsrc-hashtb', and write a new value of (file-exists-p working-file))) (unwind-protect - (progn + (with-file-modes (file-modes startup-file) (gnus-with-output-to-file working-file (gnus-gnus-to-quick-newsrc-format) (gnus-run-hooks 'gnus-save-quick-newsrc-hook)) @@ -2822,14 +2822,12 @@ values from `gnus-newsrc-hashtb', and write a new value of ;; file. (let ((buffer-backed-up nil) (buffer-file-name startup-file) - (file-precious-flag t) - (setmodes (file-modes startup-file))) + (file-precious-flag t)) ;; Backup the current version of the startup file. (backup-buffer) ;; Replace the existing startup file with the temp file. (rename-file working-file startup-file t) - (gnus-set-file-modes startup-file setmodes) (setq gnus-save-newsrc-file-last-timestamp (file-attribute-modification-time (file-attributes startup-file))))) @@ -3004,14 +3002,14 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'." (defun gnus-slave-save-newsrc () (with-current-buffer gnus-dribble-buffer - (let ((slave-name - (make-temp-file (concat gnus-current-startup-file "-slave-"))) - (modes (ignore-errors - (file-modes (concat gnus-current-startup-file ".eld"))))) - (let ((coding-system-for-write gnus-ding-file-coding-system)) - (gnus-write-buffer slave-name)) - (when modes - (gnus-set-file-modes slave-name modes))))) + (with-file-modes (or (ignore-errors + (file-modes + (concat gnus-current-startup-file ".eld"))) + (default-file-modes)) + (let ((slave-name + (make-temp-file (concat gnus-current-startup-file "-slave-")))) + (let ((coding-system-for-write gnus-ding-file-coding-system)) + (gnus-write-buffer slave-name)))))) (defun gnus-master-read-slave-newsrc () (let ((slave-files diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index a40e563e755..a47e6576230 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -12310,7 +12310,7 @@ no matter what the properties `:decode' and `:headers' are." (buffer-string)))))) (put 'gnus-summary-save-in-pipe :headers headers)) (unless (zerop (length result)) - (if (with-current-buffer (get-buffer-create result-buffer) + (if (with-current-buffer (gnus-get-buffer-create result-buffer) (erase-buffer) (insert result) (prog1 @@ -12498,7 +12498,7 @@ save those articles instead." (gnus-activate-group to-newsgroup nil nil to-method) (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup)) + (user-error "No such group: %s" to-newsgroup)) to-newsgroup))) (defvar gnus-summary-save-parts-counter) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 23c62b4f939..eb0fd2522d3 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -950,7 +950,7 @@ FILENAME exists and is Babyl format." (setq rmail-default-rmail-file filename) ; 22 (setq rmail-default-file filename)) ; 23 (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*")) + (tmpbuf (gnus-get-buffer-create " *Gnus-output*")) ;; Babyl rmail.el defines this, mbox does not. (babyl (fboundp 'rmail-insert-rmail-file-header))) (save-excursion @@ -1036,7 +1036,7 @@ FILENAME exists and is Babyl format." (require 'nnmail) (setq filename (expand-file-name filename)) (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) + (tmpbuf (gnus-get-buffer-create " *Gnus-output*"))) (save-excursion ;; Create the file, if it doesn't exist. (when (and (not (get-file-buffer filename)) @@ -1457,7 +1457,7 @@ CHOICE is a list of the choice char and help message at IDX." (setq tchar (read-char)) (when (not (assq tchar choice)) (setq tchar nil) - (setq buf (get-buffer-create "*Gnus Help*")) + (setq buf (gnus-get-buffer-create "*Gnus Help*")) (pop-to-buffer buf) (fundamental-mode) (buffer-disable-undo) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index d40ba9cef42..4037221f496 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -1781,8 +1781,8 @@ Gnus might fail to display all of it.") gnus-uu-tmp-dir))) (setq gnus-uu-work-dir - (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir)) - (gnus-set-file-modes gnus-uu-work-dir 448) + (with-file-modes #o700 + (make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))) (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) (push (cons gnus-newsgroup-name gnus-uu-work-dir) gnus-uu-tmp-alist)))) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 6df26b4af8c..caeab7f55af 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -660,7 +660,7 @@ be used directly.") (defun gnus-add-buffer () "Add the current buffer to the list of Gnus buffers." (gnus-prune-buffers) - (push (current-buffer) gnus-buffers)) + (cl-pushnew (current-buffer) gnus-buffers)) (defmacro gnus-kill-buffer (buffer) "Kill BUFFER and remove from the list of Gnus buffers." diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 52343d4fa37..f5b68789b85 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -740,9 +740,11 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (when delay (sleep-for delay))) +(declare-function gnus-get-buffer-create "gnus" (name)) (defun mail-source-call-script (script) + (require 'gnus) (let ((background nil) - (stderr (get-buffer-create " *mail-source-stderr*")) + (stderr (gnus-get-buffer-create " *mail-source-stderr*")) result) (when (string-match "& *$" script) (setq script (substring script 0 (match-beginning 0)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index adefa0efd65..f1ace0eeb2e 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -322,7 +322,7 @@ used." :group 'message-various) (defcustom message-subject-trailing-was-ask-regexp - "[ \t]*\\([[(]+[Ww][Aa][Ss]:?[ \t]*.*[])]+\\)" + "[ \t]*\\([[(]+[Ww][Aa][Ss].*[])]+\\)" "Regexp matching \"(was: <old subject>)\" in the subject line. The function `message-strip-subject-trailing-was' uses this regexp if @@ -337,7 +337,7 @@ It is okay to create some false positives here, as the user is asked." :type 'regexp) (defcustom message-subject-trailing-was-regexp - "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)" + "[ \t]*\\((*[Ww][Aa][Ss]:.*)\\)" "Regexp matching \"(was: <old subject>)\" in the subject line. If `message-subject-trailing-was-query' is set to t, the subject is @@ -1986,6 +1986,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (autoload 'gnus-delay-article "gnus-delay") (autoload 'gnus-extract-address-components "gnus-util") (autoload 'gnus-find-method-for-group "gnus") +(autoload 'gnus-get-buffer-create "gnus") (autoload 'gnus-group-name-charset "gnus-group") (autoload 'gnus-group-name-decode "gnus-group") (autoload 'gnus-groups-from-server "gnus") @@ -7310,7 +7311,7 @@ If ARG, allow editing of the cancellation message." ;; Make control message. (if arg (message-news) - (setq buf (set-buffer (get-buffer-create " *message cancel*")))) + (setq buf (set-buffer (gnus-get-buffer-create " *message cancel*")))) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "From: " from "\n" @@ -7731,7 +7732,7 @@ is for the internal use." gcc beg) ;; We first set up a normal mail buffer. (unless (message-mail-user-agent) - (set-buffer (get-buffer-create " *message resend*")) + (set-buffer (gnus-get-buffer-create " *message resend*")) (let ((inhibit-read-only t)) (erase-buffer))) (let ((message-this-is-mail t) diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index 6b4308e9790..56253afa193 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -24,6 +24,7 @@ (require 'mm-decode) (autoload 'gnus-recursive-directory-files "gnus-util") +(autoload 'gnus-get-buffer-create "gnus") (autoload 'mailcap-extension-to-mime "mailcap") (defvar mm-archive-decoders @@ -41,8 +42,9 @@ dir) (unless decoder (error "No decoder found for %s" type)) - (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir)) - (set-file-modes dir #o700) + (with-file-modes #o700 + (setq dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) + 'dir))) (unwind-protect (progn (mm-with-unibyte-buffer @@ -56,7 +58,7 @@ (append (cdr decoder) (list dir))) (delete-file file)) (apply 'call-process-region (point-min) (point-max) (car decoder) - nil (get-buffer-create "*tnef*") + nil (gnus-get-buffer-create "*tnef*") nil (append (cdr decoder) (list dir))))) `("multipart/mixed" ,handle diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d33bb56dc9e..2dab278b373 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -602,11 +602,10 @@ files left at the next time." (push temp fails))) (if fails ;; Schedule the deletion of the files left at the next time. - (progn + (with-file-modes #o600 (write-region (concat (mapconcat 'identity (nreverse fails) "\n") "\n") - nil cache-file nil 'silent) - (set-file-modes cache-file #o600)) + nil cache-file nil 'silent)) (when (file-exists-p cache-file) (ignore-errors (delete-file cache-file)))) (setq mm-temp-files-to-be-deleted nil))) @@ -911,8 +910,10 @@ external if displayed external." ;; The function is a string to be executed. (mm-insert-part handle) (mm-add-meta-html-tag handle) - (let* ((dir (make-temp-file - (expand-file-name "emm." mm-tmp-directory) 'dir)) + ;; We create a private sub-directory where we store our files. + (let* ((dir (with-file-modes #o700 + (make-temp-file + (expand-file-name "emm." mm-tmp-directory) 'dir))) (filename (or (mail-content-type-get (mm-handle-disposition handle) 'filename) @@ -924,8 +925,6 @@ external if displayed external." (assoc "needsterminal" mime-info))) (copiousoutput (assoc "copiousoutput" mime-info)) file buffer) - ;; We create a private sub-directory where we store our files. - (set-file-modes dir #o700) (if filename (setq file (expand-file-name (gnus-map-function mm-file-name-rewrite-functions @@ -941,8 +940,9 @@ external if displayed external." ;; `mailcap-mime-extensions'. (setq suffix (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))) - (setq file (make-temp-file (expand-file-name "mm." dir) - nil suffix)))) + (setq file (with-file-modes #o600 + (make-temp-file (expand-file-name "mm." dir) + nil suffix))))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) ;; The file is deleted after the viewer exists. If the users edits diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index e6fdc93da24..aedd6c948c2 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -192,7 +192,7 @@ This can be either \"inline\" or \"attachment\".") ,(lambda () (mm-uu-verbatim-marks-extract 0 0)) nil) (LaTeX - "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]" + "^\\([\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]" "^\\\\end{document}" ,#'mm-uu-latex-extract nil @@ -251,19 +251,23 @@ The value should be nil on displays where the face (((type tty) (class color) (background dark)) - (:background "dark blue")) + (:background "dark blue" + :extend t)) (((class color) (background dark)) (:foreground "light yellow" - :background "dark green")) + :background "dark green" + :extend t)) (((type tty) (class color) (background light)) - (:foreground "dark blue")) + (:foreground "dark blue" + :extend t)) (((class color) (background light)) (:foreground "dark green" - :background "light yellow")) + :background "light yellow" + :extend t)) (t ())) "Face for extracted buffers." diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 3cc463d5d4c..4754f37a2da 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -154,14 +154,9 @@ Whether the passphrase is cached at all is controlled by (write-region (point-min) (point-max) file)) (push file certfiles) (push file tmpfiles))) - (if (smime-encrypt-buffer certfiles) - (progn - (while (setq tmp (pop tmpfiles)) - (delete-file tmp)) - t) - (while (setq tmp (pop tmpfiles)) - (delete-file tmp)) - nil)) + (smime-encrypt-buffer certfiles) + (while (setq tmp (pop tmpfiles)) + (delete-file tmp))) (goto-char (point-max))) (defvar gnus-extract-address-components) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index cdd8f3d3a50..3d86c5bc407 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -487,11 +487,8 @@ type detected." (= (length cont) 1) content-type) (setcdr (assq 'type (cdr (car cont))) content-type)) - (when (and (consp (car cont)) - (= (length cont) 1) - (fboundp 'libxml-parse-html-region) - (equal (cdr (assq 'type (car cont))) "text/html")) - (setq cont (mml-expand-html-into-multipart-related (car cont)))) + (when (fboundp 'libxml-parse-html-region) + (setq cont (mapcar 'mml-expand-all-html-into-multipart-related cont))) (prog1 (with-temp-buffer (set-buffer-multibyte nil) @@ -510,6 +507,18 @@ type detected." (buffer-string)) (setq message-options options))))) +(defun mml-expand-all-html-into-multipart-related (cont) + (cond ((and (eq (car cont) 'part) + (equal (cdr (assq 'type cont)) "text/html")) + (mml-expand-html-into-multipart-related cont)) + ((eq (car cont) 'multipart) + (let ((cur (cdr cont))) + (while (consp cur) + (setcar cur (mml-expand-all-html-into-multipart-related (car cur))) + (setf cur (cdr cur)))) + cont) + (t cont))) + (defun mml-expand-html-into-multipart-related (cont) (let ((new-parts nil) (cid 1)) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 1e72f681797..d1d150ad2ee 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -293,6 +293,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (substring alg (match-end 0)) alg)))) +(autoload 'gnus-get-buffer-create "gnus") + (defun mml2015-mailcrypt-verify (handle ctl) (catch 'error (let (part) @@ -330,7 +332,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (replace-match "-----BEGIN PGP SIGNATURE-----" t t)) (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t) (replace-match "-----END PGP SIGNATURE-----" t t))) - (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*"))) + (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*"))) (unless (condition-case err (prog1 (funcall mml2015-verify-function) @@ -359,7 +361,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." handle))) (defun mml2015-mailcrypt-clear-verify () - (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*"))) + (let ((mc-gpg-debug-buffer (gnus-get-buffer-create " *gnus gpg debug*"))) (if (condition-case err (prog1 (funcall mml2015-verify-function) @@ -725,6 +727,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa") +(autoload 'gnus-create-image "gnus-util") + (defun mml2015-epg-key-image (key-id) "Return the image of a key, if any." (with-temp-buffer @@ -949,7 +953,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." ;;; General wrapper (autoload 'gnus-buffer-live-p "gnus-util") -(autoload 'gnus-get-buffer-create "gnus") (defun mml2015-clean-buffer () (if (gnus-buffer-live-p mml2015-result-buffer) diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 6890f1dceeb..cb22933b529 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -293,7 +293,7 @@ (deffoo nnbabyl-request-move-article (article group server accept-form &optional last move-is-internal) - (let ((buf (get-buffer-create " *nnbabyl move*")) + (let ((buf (gnus-get-buffer-create " *nnbabyl move*")) result) (and (nnbabyl-request-article article group server) diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 24a3df1e27a..ac394ae53d7 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -597,7 +597,7 @@ all. This may very well take some time.") (deffoo nndiary-request-move-article (article group server accept-form &optional last move-is-internal) - (let ((buf (get-buffer-create " *nndiary move*")) + (let ((buf (gnus-get-buffer-create " *nndiary move*")) result) (nndiary-possibly-change-directory group server) (nndiary-update-file-alist) @@ -831,7 +831,7 @@ all. This may very well take some time.") ;; Find an article number in the current group given the Message-ID. (defun nndiary-find-group-number (id) - (with-current-buffer (get-buffer-create " *nndiary id*") + (with-current-buffer (gnus-get-buffer-create " *nndiary id*") (let ((alist nndiary-group-alist) number) ;; We want to look through all .overview files, but we want to @@ -999,8 +999,8 @@ all. This may very well take some time.") (defun nndiary-open-nov (group) (or (cdr (assoc group nndiary-nov-buffer-alist)) - (let ((buffer (get-buffer-create (format " *nndiary overview %s*" - group)))) + (let ((buffer (gnus-get-buffer-create + (format " *nndiary overview %s*" group)))) (with-current-buffer buffer (set (make-local-variable 'nndiary-nov-buffer-file-name) (expand-file-name @@ -1086,7 +1086,7 @@ all. This may very well take some time.") (defun nndiary-generate-nov-file (dir files) (let* ((dir (file-name-as-directory dir)) (nov (concat dir nndiary-nov-file-name)) - (nov-buffer (get-buffer-create " *nov*")) + (nov-buffer (gnus-get-buffer-create " *nov*")) chars file headers) ;; Init the nov buffer. (with-current-buffer nov-buffer diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 0ba63915c94..36b67a8fd13 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -347,7 +347,7 @@ from the document.") (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) (push (cons group (setq nndoc-current-buffer - (get-buffer-create + (gnus-get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist) (setq nndoc-dissection-alist nil) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 3ee86a696cb..e5dda990d6b 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -231,7 +231,7 @@ are generated if and only if they are also in `message-draft-headers'." (deffoo nndraft-request-move-article (article group server accept-form &optional last move-is-internal) (nndraft-possibly-change-group group) - (let ((buf (get-buffer-create " *nndraft move*")) + (let ((buf (gnus-get-buffer-create " *nndraft move*")) result) (and (nndraft-request-article article group server) @@ -325,7 +325,7 @@ are generated if and only if they are also in `message-draft-headers'." (save-excursion (prog1 (progn - (set-buffer (get-buffer-create " *draft tmp*")) + (set-buffer (gnus-get-buffer-create " *draft tmp*")) (setq buffer-file-name file) (make-auto-save-file-name)) (kill-buffer (current-buffer))))) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 9e190515f18..9f1fdbae5ae 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -381,7 +381,7 @@ included.") (defun nneething-get-head (file) "Either find the head in FILE or make a head for FILE." - (with-current-buffer (get-buffer-create nneething-work-buffer) + (with-current-buffer (gnus-get-buffer-create nneething-work-buffer) (setq case-fold-search nil) (buffer-disable-undo) (erase-buffer) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 342ac48ba85..d1eeb04697e 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -465,7 +465,7 @@ all. This may very well take some time.") (deffoo nnfolder-request-move-article (article group server accept-form &optional last move-is-internal) (save-excursion - (let ((buf (get-buffer-create " *nnfolder move*")) + (let ((buf (gnus-get-buffer-create " *nnfolder move*")) result) (and (nnfolder-request-article article group server) @@ -1096,7 +1096,7 @@ This command does not work if you use short group names." (defun nnfolder-open-nov (group) (or (cdr (assoc group nnfolder-nov-buffer-alist)) - (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group)))) + (let ((buffer (gnus-get-buffer-create (format " *nnfolder overview %s*" group)))) (with-current-buffer buffer (set (make-local-variable 'nnfolder-nov-buffer-file-name) (nnfolder-group-nov-pathname group)) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 03b08854b11..fee7a169ff9 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -209,7 +209,7 @@ on your system, you could say something like: ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance don't ;; always go hand in hand. - (vector + (make-full-mail-header ;; Number. (or number 0) ;; Subject. @@ -487,8 +487,8 @@ the line could be found." (< num article))) (forward-line 1) (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) + (unless (eobp) + (setq num (read cur)))) (unless (eq num article) (goto-char found))) (beginning-of-line) @@ -502,10 +502,12 @@ the line could be found." "Coding system used in file backends of Gnus.") (defvar nnheader-callback-function nil) +(autoload 'gnus-get-buffer-create "gnus") + (defun nnheader-init-server-buffer () "Initialize the Gnus-backend communication buffer." (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) + (setq nntp-server-buffer (gnus-get-buffer-create " *nntpd*"))) (with-current-buffer nntp-server-buffer (erase-buffer) (mm-enable-multibyte) @@ -630,7 +632,7 @@ the line could be found." (defun nnheader-set-temp-buffer (name &optional noerase) "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." - (set-buffer (get-buffer-create name)) + (set-buffer (gnus-get-buffer-create name)) (buffer-disable-undo) (unless noerase (erase-buffer)) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c383e0146f3..3c4e75ede82 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -1937,7 +1937,7 @@ Return the server's response to the SELECT or EXAMINE command." (defun nnimap-log-buffer () (let ((name "*imap log*")) (or (get-buffer name) - (with-current-buffer (get-buffer-create name) + (with-current-buffer (gnus-get-buffer-create name) (setq-local window-point-insertion-type t) (current-buffer))))) diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 823bc2b423e..0277524a8c6 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -617,7 +617,8 @@ A non-nil `specs' arg must be an alist with `nnir-query-spec' and (list (gnus-group-group-name)) (mapcar (lambda (entry) (gnus-info-group (cadr entry))) - (gnus-topic-find-groups (gnus-group-topic-name))))) + (gnus-topic-find-groups (gnus-group-topic-name) + nil t nil t)))) gnus-group-server)))) (query-spec (or (cdr (assq 'nnir-query-spec specs)) @@ -1234,7 +1235,7 @@ Windows NT 4.0." (when (equal "" qstring) (error "swish++: You didn't enter anything")) - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (erase-buffer) (if groupspec @@ -1316,7 +1317,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (when (equal "" qstring) (error "swish-e: You didn't enter anything")) - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (erase-buffer) (message "Doing swish-e query %s..." query) @@ -1401,7 +1402,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." (setq groupspec (regexp-opt (mapcar (lambda (x) (gnus-group-real-name x)) group)))) - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (erase-buffer) (message "Doing hyrex-search query %s..." query) (let* ((cp-list @@ -1480,7 +1481,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." score group article (process-environment (copy-sequence process-environment))) (setenv "LC_MESSAGES" "C") - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (erase-buffer) (let* ((cp-list `( ,nnir-namazu-program @@ -1561,7 +1562,7 @@ construct path: search terms (see the variable (when (equal "" qstring) (error "notmuch: You didn't enter anything")) - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (erase-buffer) (if groups @@ -1635,7 +1636,7 @@ construct path: search terms (see the variable (message "Searching %s using find-grep..." (or group server)) (save-window-excursion - (set-buffer (get-buffer-create nnir-tmp-buffer)) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) (if (> gnus-verbose 6) (pop-to-buffer (current-buffer))) (cd directory) ; Using relative paths simplifies diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index d64d0ed0006..6e01b5c4d0b 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -1047,7 +1047,7 @@ will be copied over from that buffer." (list (list group "")) nnmail-split-methods))) ;; Insert the incoming file. - (with-current-buffer (get-buffer-create nnmail-article-buffer) + (with-current-buffer (gnus-get-buffer-create nnmail-article-buffer) (erase-buffer) (if (bufferp incoming) (insert-buffer-substring incoming) @@ -1574,7 +1574,7 @@ See the documentation for the variable `nnmail-split-fancy' for details." () ; The buffer is open. (with-current-buffer (setq nnmail-cache-buffer - (get-buffer-create " *nnmail message-id cache*")) + (gnus-get-buffer-create " *nnmail message-id cache*")) (gnus-add-buffer) (when (file-exists-p nnmail-message-id-cache-file) (nnheader-insert-file-contents nnmail-message-id-cache-file)) @@ -2065,7 +2065,7 @@ Doesn't change point." (when nnmail-split-tracing (push split nnmail-split-trace)) (when nnmail-debug-splitting - (with-current-buffer (get-buffer-create "*nnmail split*") + (with-current-buffer (gnus-get-buffer-create "*nnmail split*") (goto-char (point-max)) (insert (format-time-string "%FT%T") " " diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index b0e79d4f238..9c7b1254413 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1,4 +1,4 @@ -;;; nnmaildir.el --- maildir backend for Gnus +;;; nnmaildir.el --- maildir backend for Gnus -*- lexical-binding:t -*- ;; This file is in the public domain. @@ -261,7 +261,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--param (pgname param) (setq param (gnus-group-find-parameter pgname param 'allow-list)) (if (vectorp param) (setq param (aref param 0))) - (eval param)) + (eval param t)) (defmacro nnmaildir--with-nntp-buffer (&rest body) (declare (debug (body))) @@ -269,15 +269,15 @@ This variable is set by `nnmaildir-request-article'.") ,@body)) (defmacro nnmaildir--with-work-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir work*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir work*") ,@body)) (defmacro nnmaildir--with-nov-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir nov*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir nov*") ,@body)) (defmacro nnmaildir--with-move-buffer (&rest body) (declare (debug (body))) - `(with-current-buffer (get-buffer-create " *nnmaildir move*") + `(with-current-buffer (gnus-get-buffer-create " *nnmaildir move*") ,@body)) (defsubst nnmaildir--subdir (dir subdir) @@ -690,7 +690,7 @@ This variable is set by `nnmaildir-request-article'.") "You must set \"directory\" in the select method") (throw 'return nil)) (setq dir (cadr dir) - dir (eval dir) + dir (eval dir t) ;FIXME: Why `eval'? dir (expand-file-name dir) dir (file-name-as-directory dir)) (unless (file-exists-p dir) @@ -717,13 +717,13 @@ This variable is set by `nnmaildir-request-article'.") (if x (progn (setq x (cadr x) - x (eval x)) + x (eval x t)) ;FIXME: Why `eval'? (setf (nnmaildir--srv-target-prefix server) x)) (setq x (assq 'create-directory defs)) (if x (progn (setq x (cadr x) - x (eval x) + x (eval x t) ;FIXME: Why `eval'? x (file-name-as-directory x)) (setf (nnmaildir--srv-target-prefix server) x)) (setf (nnmaildir--srv-target-prefix server) ""))) @@ -1428,7 +1428,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--with-move-buffer (erase-buffer) (nnheader-insert-file-contents nnmaildir--file) - (setq result (eval accept-form))) + (setq result (eval accept-form t))) (unless (or (null result) (nnmaildir--param pgname 'read-only)) (nnmaildir--unlink nnmaildir--file) (nnmaildir--expired-article group article)) @@ -1544,7 +1544,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-request-expire-articles (ranges &optional gname server force) (let ((no-force (not force)) (group (nnmaildir--prepare server gname)) - pgname time boundary high low target dir nlist + pgname time boundary target dir nlist didnt nnmaildir--file nnmaildir-article-file-name deactivate-mark) (catch 'return @@ -1720,18 +1720,23 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir-close-group (gname &optional server) (let ((group (nnmaildir--prepare server gname)) - pgname ls dir msgdir files flist dirs) + pgname ls dir msgdir files dirs + (fset (make-hash-table :test #'equal))) (if (null group) (progn (setf (nnmaildir--srv-error nnmaildir--cur-server) (concat "No such group: " gname)) nil) + ;; Delete the now obsolete NOV files. + ;; FIXME: This can take a somewhat long time, so maybe it's better + ;; to do it asynchronously (i.e. in an idle timer). (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname) ls (nnmaildir--group-ls nnmaildir--cur-server pgname) dir (nnmaildir--srv-dir nnmaildir--cur-server) dir (nnmaildir--srvgrp-dir dir gname) msgdir (if (nnmaildir--param pgname 'read-only) (nnmaildir--new dir) (nnmaildir--cur dir)) + ;; The dir with the NOV files. dir (nnmaildir--nndir dir) dirs (cons (nnmaildir--nov-dir dir) (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]" @@ -1744,14 +1749,15 @@ This variable is set by `nnmaildir-request-article'.") (save-match-data (dolist (file files) (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file) - (push (match-string 1 file) flist))) + (puthash (match-string 1 file) t fset))) + ;; Not sure why, but we specifically avoid deleting the `:' file. + (puthash ":" t fset) (dolist (dir dirs) (setq files (cdr dir) dir (file-name-as-directory (car dir))) (dolist (file files) - (unless (or (member file flist) (string= file ":")) - (setq file (concat dir file)) - (delete-file file)))) + (unless (gethash file fset) + (delete-file (concat dir file))))) t))) (defun nnmaildir-close-server (&optional server _defs) diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index b3329212f84..dcecfcf6519 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -1249,7 +1249,7 @@ Marks propagation has to be enabled for this to work." If THREADS is non-nil, enable full threads." (let ((args (cons (car command) '(nil t nil)))) (with-current-buffer - (get-buffer-create nnmairix-mairix-output-buffer) + (gnus-get-buffer-create nnmairix-mairix-output-buffer) (erase-buffer) (when (> (length command) 1) (setq args (append args (cdr command)))) @@ -1267,7 +1267,7 @@ If THREADS is non-nil, enable full threads." "Call mairix binary with COMMAND and QUERY in raw mode." (let ((args (cons (car command) '(nil t nil)))) (with-current-buffer - (get-buffer-create nnmairix-mairix-output-buffer) + (gnus-get-buffer-create nnmairix-mairix-output-buffer) (erase-buffer) (when (> (length command) 1) (setq args (append args (cdr command)))) @@ -1404,7 +1404,7 @@ TYPE is either `nov' or `headers'." (nnheader-message 7 "nnmairix: Rewriting headers...") (cond ((eq type 'nov) - (let ((buf (get-buffer-create " *nnmairix buffer*")) + (let ((buf (gnus-get-buffer-create " *nnmairix buffer*")) (corr (not (zerop numc))) (name (buffer-name nntp-server-buffer)) header cur xref) diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index eb8fcf37a25..a191f887c78 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -280,7 +280,7 @@ (deffoo nnmbox-request-move-article (article group server accept-form &optional last move-is-internal) - (let ((buf (get-buffer-create " *nnmbox move*")) + (let ((buf (gnus-get-buffer-create " *nnmbox move*")) result) (and (nnmbox-request-article article group server) diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index c075f298986..d2f63bd3db1 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -296,7 +296,7 @@ as unread by Gnus.") (deffoo nnmh-request-move-article (article group server accept-form &optional last move-is-internal) - (let ((buf (get-buffer-create " *nnmh move*")) + (let ((buf (gnus-get-buffer-create " *nnmh move*")) result) (and (nnmh-deletable-article-p group article) diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 6c7b25b5e76..2c39ab8e36a 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -361,7 +361,7 @@ non-nil.") (deffoo nnml-request-move-article (article group server accept-form &optional last move-is-internal) - (let ((buf (get-buffer-create " *nnml move*")) + (let ((buf (gnus-get-buffer-create " *nnml move*")) (file-name-coding-system nnmail-pathname-coding-system) result) (nnml-possibly-change-directory group server) @@ -572,7 +572,7 @@ non-nil.") ;; Find an article number in the current group given the Message-ID. (defun nnml-find-group-number (id server) - (with-current-buffer (get-buffer-create " *nnml id*") + (with-current-buffer (gnus-get-buffer-create " *nnml id*") (let ((alist nnml-group-alist) number) ;; We want to look through all .overview files, but we want to @@ -772,11 +772,10 @@ article number. This function is called narrowed to an article." headers)))) (defun nnml-get-nov-buffer (group &optional incrementalp) - (let ((buffer (get-buffer-create (format " *nnml %soverview %s*" - (if incrementalp - "incremental " - "") - group))) + (let ((buffer (gnus-get-buffer-create + (format " *nnml %soverview %s*" + (if incrementalp "incremental " "") + group))) (file-name-coding-system nnmail-pathname-coding-system)) (with-current-buffer buffer (set (make-local-variable 'nnml-nov-buffer-file-name) @@ -873,7 +872,7 @@ Unless no-active is non-nil, update the active file too." (defun nnml-generate-nov-file (dir files) (let* ((dir (file-name-as-directory dir)) (nov (concat dir nnml-nov-file-name)) - (nov-buffer (get-buffer-create " *nov*")) + (nov-buffer (gnus-get-buffer-create " *nov*")) chars file headers) (with-current-buffer nov-buffer ;; Init the nov buffer. diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index fa4d22fb1cc..116d7ee9fb2 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -739,7 +739,7 @@ Read the file and attempt to subscribe to each Feed in the file." "OPML subscription export. Export subscriptions to a buffer in OPML Format." (interactive) - (with-current-buffer (get-buffer-create "*OPML Export*") + (with-current-buffer (gnus-get-buffer-create "*OPML Export*") (set-buffer-file-coding-system 'utf-8) (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n" "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n" diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 6ce8724cbbb..6be6d11a48d 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -309,7 +309,7 @@ backend doesn't catch this error.") (defun nntp-record-command (string) "Record the command STRING." - (with-current-buffer (get-buffer-create "*nntp-log*") + (with-current-buffer (gnus-get-buffer-create "*nntp-log*") (goto-char (point-max)) (insert (format-time-string "%Y%m%dT%H%M%S.%3N") " " nntp-address " " string "\n"))) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index e1290a9c774..54c2f7be820 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -97,7 +97,7 @@ component group will show up when you enter the virtual group.") (if (stringp (car articles)) 'headers (let ((vbuf (nnheader-set-temp-buffer - (get-buffer-create " *virtual headers*"))) + (gnus-get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) (sysname (system-name)) cgroup carticle article result prefix) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 5632bdaf250..96a7da2313c 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -579,7 +579,7 @@ This must be a list. For example, `(\"-C\" \"configfile\")'." (defcustom spam-spamassassin-positive-spam-flag-header "YES" "The regex on `spam-spamassassin-spam-flag-header' for positive spam identification." - :type 'string + :type 'regexp :group 'spam-spamassassin) (defcustom spam-spamassassin-spam-status-header "X-Spam-Status" diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 0e2ae6b3c3c..36c2a8b186d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1562,6 +1562,103 @@ BUFFER should be a buffer or a buffer name." (insert "\nThe parent category table is:") (describe-vector table 'help-describe-category-set)))))) +(defun help-fns-find-keymap-name (keymap) + "Find the name of the variable with value KEYMAP. +Return nil if KEYMAP is not a valid keymap, or if there is no +variable with value KEYMAP." + (when (keymapp keymap) + (let ((name (catch 'found-keymap + (mapatoms (lambda (symb) + (when (and (boundp symb) + (eq (symbol-value symb) keymap) + (not (eq symb 'keymap)) + (throw 'found-keymap symb))))) + nil))) + ;; Follow aliasing. + (or (ignore-errors (indirect-variable name)) name)))) + +(defun help-fns--most-relevant-active-keymap () + "Return the name of the most relevant active keymap. +The heuristic to determine which keymap is most likely to be +relevant to a user follows this order: + +1. 'keymap' text property at point +2. 'local-map' text property at point +3. the `current-local-map' + +This is used to set the default value for the interactive prompt +in `describe-keymap'. See also `Searching the Active Keymaps'." + (help-fns-find-keymap-name (or (get-char-property (point) 'keymap) + (if (get-text-property (point) 'local-map) + (get-char-property (point) 'local-map) + (current-local-map))))) + +;;;###autoload +(defun describe-keymap (keymap) + "Describe key bindings in KEYMAP. +When called interactively, prompt for a variable that has a +keymap value." + (interactive + (let* ((km (help-fns--most-relevant-active-keymap)) + (val (completing-read + (format "Keymap (default %s): " km) + obarray + (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) + t nil 'keymap-name-history + (symbol-name km)))) + (unless (equal val "") + (setq km (intern val))) + (unless (and km (keymapp (symbol-value km))) + (user-error "Not a keymap: %s" km)) + (list km))) + (let (used-gentemp) + (unless (and (symbolp keymap) + (boundp keymap) + (keymapp (symbol-value keymap))) + (when (not (keymapp keymap)) + (if (symbolp keymap) + (error "Not a keymap variable: %S" keymap) + (error "Not a keymap"))) + (let ((sym nil)) + (unless sym + (setq sym (cl-gentemp "KEYMAP OBJECT (no variable) ")) + (setq used-gentemp t) + (set sym keymap)) + (setq keymap sym))) + ;; Follow aliasing. + (setq keymap (or (ignore-errors (indirect-variable keymap)) keymap)) + (help-setup-xref (list #'describe-keymap keymap) + (called-interactively-p 'interactive)) + (let* ((name (symbol-name keymap)) + (doc (documentation-property keymap 'variable-documentation)) + (file-name (find-lisp-object-file-name keymap 'defvar))) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (unless used-gentemp + (princ (format-message "%S is a keymap variable" keymap)) + (if (not file-name) + (princ ".\n\n") + (princ (format-message + " defined in `%s'.\n\n" + (if (eq file-name 'C-source) + "C source code" + (file-name-nondirectory file-name)))) + (save-excursion + (re-search-backward (substitute-command-keys + "`\\([^`']+\\)'") + nil t) + (help-xref-button 1 'help-variable-def + keymap file-name)))) + (when (and (not (equal "" doc)) doc) + (princ "Documentation:\n") + (princ (format-message "%s\n\n" doc))) + ;; Use `insert' instead of `princ', so control chars (e.g. \377) + ;; insert correctly. + (insert (substitute-command-keys (concat "\\{" name "}")))))) + ;; Cleanup. + (when used-gentemp + (makunbound keymap)))) + ;;; Replacements for old lib-src/ programs. Don't seem especially useful. diff --git a/lisp/hexl.el b/lisp/hexl.el index 2535d581db4..58518e74169 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -701,10 +701,7 @@ With prefix arg N, puts point N bytes of the way from the true beginning." (defun hexl-end-of-line () "Goto end of line in Hexl mode." (interactive) - (hexl-goto-address (let ((address (logior (hexl-current-address) 15))) - (if (> address hexl-max-address) - (setq address hexl-max-address)) - address))) + (hexl-goto-address (min hexl-max-address (logior (hexl-current-address) 15)))) (defun hexl-scroll-down (arg) "Scroll hexl buffer window upward ARG lines; or near full window if no ARG." @@ -749,7 +746,7 @@ If there's no byte at the target address, move to the first or last line." "Go to end of 1KB boundary." (interactive) (hexl-goto-address - (max hexl-max-address (logior (hexl-current-address) 1023)))) + (min hexl-max-address (logior (hexl-current-address) 1023)))) (defun hexl-beginning-of-512b-page () "Go to beginning of 512 byte boundary." @@ -760,7 +757,7 @@ If there's no byte at the target address, move to the first or last line." "Go to end of 512 byte boundary." (interactive) (hexl-goto-address - (max hexl-max-address (logior (hexl-current-address) 511)))) + (min hexl-max-address (logior (hexl-current-address) 511)))) (defun hexl-quoted-insert (arg) "Read next input character and insert it. @@ -935,7 +932,7 @@ CH must be a unibyte character whose value is between 0 and 255." (goto-char ascii-position) (delete-char 1) (insert (hexl-printable-character ch)) - (or (eq address hexl-max-address) + (or (= address hexl-max-address) (setq address (1+ address))) (hexl-goto-address address) (if at-ascii-position diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 152c70a64e2..466f6f5ee0e 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -197,7 +197,7 @@ It takes only one argument, the filename." "Regex to remove from the `<style> a' variant of an htmlfontify CSS class." :group 'htmlfontify :tag "src-doc-link-unstyle" - :type '(string)) + :type '(regexp)) (defcustom hfy-link-extn nil "File extension used for href links. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 851b25f9ec0..c9a748830c1 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -339,6 +339,8 @@ directory, like `default-directory'." (defcustom ibuffer-load-hook nil "Hook run when Ibuffer is loaded." :type 'hook) +(make-obsolete-variable 'ibuffer-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom ibuffer-marked-face 'warning "Face used for displaying marked buffers." diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 768e941490d..1cc38ba714b 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -771,8 +771,8 @@ Increase at own risk.") process) (when (not (file-exists-p thumbnail-dir)) (message "Creating thumbnail directory") - (make-directory thumbnail-dir t) - (set-file-modes thumbnail-dir #o700)) + (with-file-modes #o700 + (make-directory thumbnail-dir t))) ;; Thumbnail file creation processes begin here and are marshaled ;; in a queue by `image-dired-create-thumb'. diff --git a/lisp/info-look.el b/lisp/info-look.el index fb3237efbb1..4e379cadef1 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -75,7 +75,7 @@ List elements are cons cells of the form If a file name matches REGEXP, then use help mode MODE instead of the buffer's major mode." - :group 'info-lookup :type '(repeat (cons (string :tag "Regexp") + :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp") (symbol :tag "Mode")))) (defvar info-lookup-history nil diff --git a/lisp/info.el b/lisp/info.el index 7a11bb3ff9d..3015e60a4f9 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3780,20 +3780,8 @@ Build a menu of the possible matches." ;; there is no "nxml.el" (it's nxml-mode.el). ;; But package.el makes the same assumption. ;; I think nxml is the only exception - maybe it should be just be renamed. - (let ((str (ignore-errors (lm-commentary (find-library-name nodename))))) - (if (null str) - (insert "Can’t find package description.\n\n") - (insert - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (delete-blank-lines) - (goto-char (point-max)) - (delete-blank-lines) - (goto-char (point-min)) - (while (re-search-forward "^;+ ?" nil t) - (replace-match "" nil nil)) - (buffer-string)))))))) + (insert (or (ignore-errors (lm-commentary (find-library-name nodename))) + (insert "Can’t find package description.\n\n")))))) ;;;###autoload (defun info-finder (&optional keywords) @@ -5135,9 +5123,8 @@ first line or header line, and for breadcrumb links.") "Additional menu-items to add to speedbar frame.") ;; Make sure our special speedbar major mode is loaded -(if (featurep 'speedbar) - (Info-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'Info-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (Info-install-speedbar-variables)) ;;; Info hierarchy display method ;;;###autoload diff --git a/lisp/informat.el b/lisp/informat.el index 9873f66f215..7750ab00898 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -337,7 +337,7 @@ Check that every node pointer points to an existing node." (point)))) (Info-extract-menu-node-name)))) (goto-char (point-min)) - (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t) + (while (re-search-forward "\\*note\\>[^:\t]*:" nil t) (goto-char (+ (match-beginning 0) 5)) (skip-chars-forward " \n") (Info-validate-node-name diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index c86b1da0ae7..5436aaa4fa0 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -283,8 +283,42 @@ wrong, use this command again to toggle back to the right mode." (interactive) (view-file (expand-file-name "HELLO" data-directory))) +(defvar mule-cmds--prefixed-command-next-coding-system nil) +(defvar mule-cmds--prefixed-command-last-coding-system nil) + +(defun mule-cmds--prefixed-command-pch () + (if (not mule-cmds--prefixed-command-next-coding-system) + (progn + (remove-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch) + (remove-hook 'prefix-command-echo-keystrokes-functions + #'mule-cmds--prefixed-command-echo) + (remove-hook 'prefix-command-preserve-state-hook + #'mule-cmds--prefixed-command-preserve)) + (setq this-command + (let ((cmd this-command) + (coding-system mule-cmds--prefixed-command-next-coding-system)) + (lambda () + (interactive) + (setq this-command cmd) + (let ((coding-system-for-read coding-system) + (coding-system-for-write coding-system) + (coding-system-require-warning t)) + (call-interactively cmd))))) + (setq mule-cmds--prefixed-command-last-coding-system + mule-cmds--prefixed-command-next-coding-system) + (setq mule-cmds--prefixed-command-next-coding-system nil))) + +(defun mule-cmds--prefixed-command-echo () + (when mule-cmds--prefixed-command-next-coding-system + (format "With coding-system %S" + mule-cmds--prefixed-command-next-coding-system))) + +(defun mule-cmds--prefixed-command-preserve () + (setq mule-cmds--prefixed-command-next-coding-system + mule-cmds--prefixed-command-last-coding-system)) + (defun universal-coding-system-argument (coding-system) - "Execute an I/O command using the specified coding system." + "Execute an I/O command using the specified CODING-SYSTEM." (interactive (let ((default (and buffer-file-coding-system (not (eq (coding-system-type buffer-file-coding-system) @@ -295,41 +329,13 @@ wrong, use this command again to toggle back to the right mode." (format "Coding system for following command (default %s): " default) "Coding system for following command: ") default)))) - ;; FIXME: This "read-key-sequence + call-interactively" loop is trying to - ;; reproduce the normal command loop, but this "can't" be done faithfully so - ;; it necessarily suffers from breakage in corner cases (e.g. it fails to run - ;; pre/post-command-hook, doesn't properly set this-command/last-command, it - ;; doesn't handle keyboard macros, ...). - (let* ((keyseq (read-key-sequence - (format "Command to execute with %s:" coding-system))) - (cmd (key-binding keyseq))) - ;; read-key-sequence ignores quit, so make an explicit check. - (if (equal last-input-event (nth 3 (current-input-mode))) - (keyboard-quit)) - (when (memq cmd '(universal-argument digit-argument)) - (call-interactively cmd) - - ;; Process keys bound in `universal-argument-map'. - (while (progn - (setq keyseq (read-key-sequence nil t) - cmd (key-binding keyseq t)) - (memq cmd '(negative-argument digit-argument - universal-argument-more))) - (setq current-prefix-arg prefix-arg prefix-arg nil) - ;; Have to bind `last-command-event' here so that - ;; `digit-argument', for instance, can compute the - ;; `prefix-arg'. - (setq last-command-event (aref keyseq 0)) - (call-interactively cmd))) - - (let ((coding-system-for-read coding-system) - (coding-system-for-write coding-system) - (coding-system-require-warning t)) - (setq current-prefix-arg prefix-arg prefix-arg nil) - ;; Have to bind `last-command-event' e.g. for `self-insert-command'. - (setq last-command-event (aref keyseq 0)) - (message "") - (call-interactively cmd)))) + (prefix-command-preserve-state) + (setq mule-cmds--prefixed-command-next-coding-system coding-system) + (add-hook 'pre-command-hook #'mule-cmds--prefixed-command-pch) + (add-hook 'prefix-command-echo-keystrokes-functions + #'mule-cmds--prefixed-command-echo) + (add-hook 'prefix-command-preserve-state-hook + #'mule-cmds--prefixed-command-preserve)) (defun set-default-coding-systems (coding-system) "Set default value of various coding systems to CODING-SYSTEM. @@ -700,8 +706,8 @@ DEFAULT is the coding system to use by default in the query." ;; buffer is displayed. (when (and unsafe (not (stringp from))) (pop-to-buffer bufname) - (goto-char (apply 'min (mapcar #'(lambda (x) (car (cadr x))) - unsafe)))) + (goto-char (apply #'min (mapcar (lambda (x) (or (car (cadr x)) (point-max))) + unsafe)))) ;; Then ask users to select one from CODINGS while showing ;; the reason why none of the defaults are not used. (with-output-to-temp-buffer "*Warning*" @@ -1402,13 +1408,13 @@ The commands `describe-input-method' and `list-input-methods' need these duplicated values to show some information about input methods without loading the relevant Quail packages. \n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)" - (if (symbolp lang-env) - (setq lang-env (symbol-name lang-env)) - (setq lang-env (purecopy lang-env))) - (if (symbolp input-method) - (setq input-method (symbol-name input-method)) - (setq input-method (purecopy input-method))) - (setq args (mapcar 'purecopy args)) + (setq lang-env (if (symbolp lang-env) + (symbol-name lang-env) + (purecopy lang-env))) + (setq input-method (if (symbolp input-method) + (symbol-name input-method) + (purecopy input-method))) + (setq args (mapcar #'purecopy args)) (let ((info (cons lang-env args)) (slot (assoc input-method input-method-alist))) (if slot diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el index 7f09eb41d17..c59538f5469 100644 --- a/lisp/international/rfc1843.el +++ b/lisp/international/rfc1843.el @@ -60,7 +60,7 @@ e-mail transmission, news posting, etc." (defcustom rfc1843-newsgroups-regexp "chinese\\|hz" "Regexp of newsgroups in which might be HZ encoded." - :type 'string + :type 'regexp :group 'mime) (defun rfc1843-decode-region (from to) diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 2a80d75fe7e..eec20ee3294 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -1,4 +1,4 @@ -;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding: utf-8-emacs; lexical-binding:t -*- +;;; titdic-cnv.el --- convert cxterm dictionary (TIT format) to Quail package -*- coding:iso-2022-7bit; lexical-binding:t -*- ;; Copyright (C) 1997-1998, 2000-2020 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -83,9 +83,9 @@ ;; how to select a translation from a list of candidates. (defvar quail-cxterm-package-ext-info - '(("chinese-4corner" "四角") - ("chinese-array30" "３ï¼") - ("chinese-ccdospy" "缩拼" + '(("chinese-4corner" "$(0(?-F(B") + ("chinese-array30" "$(0#R#O(B") + ("chinese-ccdospy" "$AKuF4(B" "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). Pinyin is the standard Roman transliteration method for Chinese. @@ -94,10 +94,10 @@ method `chinese-py'. This input method works almost the same way as `chinese-py'. The difference is that you type a single key for these Pinyin spelling. - Pinyin: zh en eng ang ch an ao ai ong sh ing yu(ü) + Pinyin: zh en eng ang ch an ao ai ong sh ing yu($A(9(B) keyseq: a f g h i j k l s u y v For example: - Chinese: å•Š æžœ ä¸ æ–‡ å…‰ 玉 å…¨ + Chinese: $A0!(B $A9{(B $AVP(B $AND(B $A9b(B $ASq(B $AH+(B Pinyin: a guo zhong wen guang yu quan Keyseq: a1 guo4 as1 wf4 guh1 yu..6 qvj6 @@ -106,14 +106,14 @@ For example: For double-width GB2312 characters corresponding to ASCII, use the input method `chinese-qj'.") - ("chinese-ecdict" "英漢" + ("chinese-ecdict" "$(05CKH(B" "In this input method, you enter a Chinese (Big5) character or word by typing the corresponding English word. For example, if you type -\"computer\", \"電腦\" is input. +\"computer\", \"$(0IZH+(B\" is input. \\<quail-translation-docstring>") - ("chinese-etzy" "倚注" + ("chinese-etzy" "$(06/0D(B" "Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1', `chinese-big5-2'). @@ -122,20 +122,20 @@ compose one Chinese character. In this input method, you enter a Chinese character by first typing keys corresponding to Zhuyin symbols (see the above table) followed by -SPC, 1, 2, 3, or 4 specifying a tone (SPC:é™°å¹³, 1:輕è², 2:陽平, 3: 上è², -4:去è²). +SPC, 1, 2, 3, or 4 specifying a tone (SPC:$(0?v(N(B, 1:$(0M=Vy(B, 2:$(0Dm(N(B, 3: $(0&9Vy(B, +4:$(0(+Vy(B). \\<quail-translation-docstring>") - ("chinese-punct-b5" "標B" + ("chinese-punct-b5" "$(0O:(BB" "Input method for Chinese punctuation and symbols of Big5 \(`chinese-big5-1' and `chinese-big5-2').") - ("chinese-punct" "æ ‡G" + ("chinese-punct" "$A1j(BG" "Input method for Chinese punctuation and symbols of GB2312 \(`chinese-gb2312').") - ("chinese-py-b5" "拼B" + ("chinese-py-b5" "$(03<(BB" "Pinyin base input method for Chinese Big5 characters \(`chinese-big5-1', `chinese-big5-2'). @@ -153,28 +153,28 @@ method `chinese-qj-b5'. The input method `chinese-py' and `chinese-tonepy' are also Pinyin based, but for the character set GB2312 (`chinese-gb2312').") - ("chinese-qj-b5" "å…¨B") + ("chinese-qj-b5" "$(0)A(BB") - ("chinese-qj" "å…¨G") + ("chinese-qj" "$AH+(BG") - ("chinese-sw" "首尾" + ("chinese-sw" "$AJWN2(B" "Radical base input method for Chinese charset GB2312 (`chinese-gb2312'). In this input method, you enter a Chinese character by typing two -keys. The first key corresponds to the first (首) radical, the second -key corresponds to the last (å°¾) radical. The correspondence of keys +keys. The first key corresponds to the first ($AJW(B) radical, the second +key corresponds to the last ($AN2(B) radical. The correspondence of keys and radicals is as below: first radical: a b c d e f g h i j k l m n o p q r s t u v w x y z - 心 冖 å°¸ 丶 ç« å£ æ‰Œ æ°µ è® è‰¹ 亻 木 礻 饣 月 纟 石 王 å…« 丿 æ—¥ 辶 çŠ ç«¹ 一 人 + $APD(B $AZ"(B $AJ,(B $AX<(B $A;p(B $A?Z(B $A^P(B $Ac_(B $AZ%(B $A\3(B $AXi(B $AD>(B $Alj(B $Ab;(B $ATB(B $Afy(B $AJ/(B $AMu(B $A0K(B $AX/(B $AHU(B $AeA(B $Aak(B $AVq(B $AR;(B $AHK(B last radical: a b c d e f g h i j k l m n o p q r s t u v w x y z - åˆ å±± 土 刀 é˜ å£ è¡£ ç–‹ 大 ä¸ åŽ¶ ç¬ å æ¹ å†‚ é—¨ 今 丨 女 ä¹™ å›— å° åŽ‚ 虫 弋 åœ + $ASV(B $AI=(B $AMA(B $A56(B $AZb(B $A?Z(B $ARB(B $Aqb(B $A4s(B $A6!(B $A[L(B $Ala(B $AJ.(B $A4u(B $AXg(B $ACE(B $A=q(B $AX-(B $AE.(B $ARR(B $A`m(B $AP!(B $A3'(B $A3f(B $A_.(B $A27(B \\<quail-translation-docstring>") - ("chinese-tonepy" "调拼" + ("chinese-tonepy" "$A5wF4(B" "Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). Pinyin is the standard roman transliteration method for Chinese. @@ -183,18 +183,18 @@ method `chinese-py'. This input method works almost the same way as `chinese-py'. The difference is that you must type 1..5 after each Pinyin spelling to -specify a tone (1:阴平, 2:阳平, 3:上声, 4下声, 5:轻声). +specify a tone (1:$ARuF=(B, 2:$AQtF=(B, 3:$AIOIy(B, 4$AOBIy(B, 5:$AGaIy(B). \\<quail-translation-docstring> -For instance, to input ä½ , you type \"n i 3 3\", the first \"n i\" is +For instance, to input $ADc(B, you type \"n i 3 3\", the first \"n i\" is a Pinyin, the next \"3\" specifies tone, and the last \"3\" selects the third character from the candidate list. For double-width GB2312 characters corresponding to ASCII, use the input method `chinese-qj'.") - ("chinese-zozy" "零注" + ("chinese-zozy" "$(0I\0D(B" "Zhuyin base input method for Chinese Big5 characters (`chinese-big5-1', `chinese-big5-2'). @@ -203,8 +203,8 @@ compose a Chinese character. In this input method, you enter a Chinese character by first typing keys corresponding to Zhuyin symbols (see the above table) followed by -SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è², -7:輕è²). +SPC, 6, 3, 4, or 7 specifying a tone (SPC:$(0?v(N(B, 6:$(0Dm(N(B, 3:$(0&9Vy(B, 4:$(0(+Vy(B, +7:$(0M=Vy(B). \\<quail-translation-docstring>"))) @@ -354,7 +354,7 @@ SPC, 6, 3, 4, or 7 specifying a tone (SPC:é™°å¹³, 6:陽平, 3:上è², 4:去è², (princ (nth 2 (assoc tit-encode tit-encode-list))) (princ "\" \"") (princ (or title - (if (string-match "[:∷：ã€]+\\([^:∷：】]+\\)" tit-prompt) + (if (string-match "[:$A!K$(0!(!J(B]+\\([^:$A!K$(0!(!K(B]+\\)" tit-prompt) (substring tit-prompt (match-beginning 1) (match-end 1)) tit-prompt))) (princ "\"\n")) @@ -580,7 +580,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; ) (defvar quail-misc-package-ext-info - '(("chinese-b5-tsangchi" "倉B" + '(("chinese-b5-tsangchi" "$(06A(BB" "cangjie-table.b5" big5 "tsang-b5.el" tsang-b5-converter "\ @@ -590,7 +590,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # unmodified versions is granted without royalty provided ;; # this notice is preserved.") - ("chinese-b5-quick" "ç°¡B" + ("chinese-b5-quick" "$(0X|(BB" "cangjie-table.b5" big5 "quick-b5.el" quick-b5-converter "\ @@ -600,7 +600,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # unmodified versions is granted without royalty provided ;; # this notice is preserved.") - ("chinese-cns-tsangchi" "倉C" + ("chinese-cns-tsangchi" "$(GT?(BC" "cangjie-table.cns" iso-2022-cn-ext "tsang-cns.el" tsang-cns-converter "\ @@ -610,7 +610,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # unmodified versions is granted without royalty provided ;; # this notice is preserved.") - ("chinese-cns-quick" "ç°¡C" + ("chinese-cns-quick" "$(Gv|(BC" "cangjie-table.cns" iso-2022-cn-ext "quick-cns.el" quick-cns-converter "\ @@ -620,7 +620,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # unmodified versions is granted without royalty provided ;; # this notice is preserved.") - ("chinese-py" "拼G" + ("chinese-py" "$AF4(BG" "pinyin.map" cn-gb-2312 "PY.el" py-converter "\ @@ -648,7 +648,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; You should have received a copy of the GNU General Public License along with ;; CCE. If not, see <https://www.gnu.org/licenses/>.") - ("chinese-ziranma" "自然" + ("chinese-ziranma" "$AWTH;(B" "ziranma.cin" cn-gb-2312 "ZIRANMA.el" ziranma-converter "\ @@ -676,7 +676,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; You should have received a copy of the GNU General Public License along with ;; CCE. If not, see <https://www.gnu.org/licenses/>.") - ("chinese-ctlau" "刘粤" + ("chinese-ctlau" "$AAuTA(B" "CTLau.html" cn-gb-2312 "CTLau.el" ctlau-gb-converter "\ @@ -701,7 +701,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # You should have received a copy of the GNU General Public License ;; # along with this program. If not, see <https://www.gnu.org/licenses/>.") - ("chinese-ctlaub" "劉粵" + ("chinese-ctlaub" "$(0N,Gn(B" "CTLau-b5.html" big5 "CTLau-b5.el" ctlau-b5-converter "\ @@ -731,38 +731,38 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; dictionary in the buffer DICBUF. The input method name of the ;; Quail package is NAME, and the title string is TITLE. -;; TSANG-P is non-nil, generate å€‰é ¡ input method. Otherwise -;; generate 簡易 (simple version of å€‰é ¡). If BIG5-P is non-nil, the +;; TSANG-P is non-nil, generate $(06AQo(B input method. Otherwise +;; generate $(0X|/y(B (simple version of $(06AQo(B). If BIG5-P is non-nil, the ;; input method is for inputting Big5 characters. Otherwise the input ;; method is for inputting CNS characters. (defun tsang-quick-converter (dicbuf tsang-p big5-p) - (let ((fulltitle (if tsang-p (if big5-p "å€‰é ¡" "å€‰é ¡") - (if big5-p "簡易" "簡易"))) + (let ((fulltitle (if tsang-p (if big5-p "$(06AQo(B" "$(GT?on(B") + (if big5-p "$(0X|/y(B" "$(Gv|Mx(B"))) dic) (goto-char (point-max)) (if big5-p - (insert (format "\"ä¸æ–‡è¼¸å…¥ã€%s】BIG5 + (insert (format "\"$(0&d'GTT&,!J(B%s$(0!K(BBIG5 - 漢語%s輸入éµç›¤ + $(0KHM$(B%s$(0TT&,WoOu(B - [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心] + [Q $(0'D(B] [W $(0(q(B] [E $(0'V(B] [R $(0&H(B] [T $(0'>(B] [Y $(0&4(B] [U $(0&U(B] [I $(0'B(B] [O $(0&*(B] [P $(0'A(B] - [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L ä¸] + [A $(0'K(B] [S $(0&T(B] [D $(0'N(B] [F $(0'W(B] [G $(0&I(B] [H $(0*M(B] [J $(0&3(B] [L $(0&d(B] - [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一] + [Z ] [X $(0[E(B] [C $(01[(B] [V $(0&M(B] [B $(0'M(B] [N $(0&_(B] [M $(0&"(B] \\\\<quail-translation-docstring>\"\n" fulltitle fulltitle)) - (insert (format "\"ä¸æ–‡è¼¸å…¥ã€%s】CNS + (insert (format "\"$(GDcEFrSD+!J(B%s$(G!K(BCNS - 漢語%s輸入éµç›¤ + $(GiGk#(B%s$(GrSD+uomu(B - [Q 手] [W ç”°] [E æ°´] [R å£] [T 廿] [Y åœ] [U å±±] [I 戈] [O 人] [P 心] + [Q $(GEC(B] [W $(GFp(B] [E $(GEU(B] [R $(GDG(B] [T $(GE=(B] [Y $(GD3(B] [U $(GDT(B] [I $(GEA(B] [O $(GD)(B] [P $(GE@(B] - [A æ—¥] [S å°¸] [D 木] [F ç«] [G 土] [H 竹] [J å] [L ä¸] + [A $(GEJ(B] [S $(GDS(B] [D $(GEM(B] [F $(GEV(B] [G $(GDH(B] [H $(GHL(B] [J $(GD2(B] [L $(GDc(B] - [Z ] [X 難] [C 金] [V 女] [B 月] [N 弓] [M 一] + [Z ] [X $(GyE(B] [C $(GOZ(B] [V $(GDL(B] [B $(GEL(B] [N $(GD^(B] [M $(GD!(B] \\\\<quail-translation-docstring>\"\n" fulltitle fulltitle))) @@ -798,35 +798,35 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (setq dic (sort dic (function (lambda (x y) (string< (car x ) (car y)))))) (dolist (elt dic) (insert (format "(%S\t%S)\n" (car elt) (cdr elt)))) - (let ((punctuation '((";" "；﹔，ã€ï¹ï¹‘" "；﹔，ã€ï¹ï¹‘") - (":" "：︰﹕．。‧﹒·" "：︰﹕．。・﹒·") - ("'" "’‘" "’‘") - ("\"" "â€â€œã€ã€žã€ƒ" "â€â€œã€ã€žã€ƒ") - ("\\" "＼﹨╲" "＼﹨╲") - ("|" "｜︱︳∣" "︱︲ô”€™ï½œ") - ("/" "ï¼âˆ•â•±" "ï¼âˆ•â•±") - ("?" "？﹖" "？﹖") - ("<" "〈＜﹤︿∠" "〈＜﹤︿∠") - (">" "〉＞﹥﹀" "〉＞﹦﹀") - ("[" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ" "〔ã€ï¹ï¸¹ï¸»ã€Œã€Žï¹ï¹ƒ") - ("]" "〕】﹞︺︼ã€ã€ï¹‚﹄" "〕】﹞︺︼ã€ã€ï¹‚﹄") - ("{" "｛﹛︷ " "｛﹛︷ ") - ("}" "ï½ï¹œï¸¸" "ï½ï¹œï¸¸") - ("`" "‵′" "′‵") - ("~" "～﹋﹌︴ï¹" "∼﹋﹌ô”€›ô”€œ") - ("!" "ï¼ï¹—" "ï¼ï¹—") - ("@" "ï¼ ï¹«" "ï¼ ï¹«") - ("#" "＃﹟" "＃﹟") - ("$" "＄﹩" "＄﹩") - ("%" "％﹪" "％﹪") - ("&" "ï¼†ï¹ " "ï¼†ï¹ ") - ("*" "＊﹡※☆★" "＊﹡※☆★") - ("(" "（﹙︵" "（﹙︵") - (")" "）﹚︶" "）﹚︶") - ("-" "–—¯￣ï¼ï¹£" "—–‾ô”¡ï¼ï¹£") - ("_" "＿Ë" "＿ô”£") - ("=" "ï¼ï¹¦" "ï¼ï¹¥") - ("+" "＋﹢" "＋﹢")))) + (let ((punctuation '((";" "$(0!'!2!"!#!.!/(B" "$(G!'!2!"!#!.!/(B") + (":" "$(0!(!+!3!%!$!&!0!1(B" "$(G!(!+!3!%!$!&!0!1(B") + ("'" "$(0!e!d(B" "$(G!e!d(B") + ("\"" "$(0!g!f!h!i!q(B" "$(G!g!f!h!i!q(B") + ("\\" "$(0"`"b#M(B" "$(G"`"b#M(B") + ("|" "$(0!6!8!:"^(B" "$(G!6!8!:"^(B") + ("/" "$(0"_"a#L(B" "$(G"_"a#L(B") + ("?" "$(0!)!4(B" "$(G!)!4(B") + ("<" "$(0!R"6"A!T"H(B" "$(G!R"6"A!T"H(B") + (">" "$(0!S"7"B!U(B" "$(G!S"7"B!U(B") + ("[" "$(0!F!J!b!H!L!V!Z!X!\(B" "$(G!F!J!b!H!L!V!Z!X!\(B") + ("]" "$(0!G!K!c!I!M!W![!Y!](B" "$(G!G!K!c!I!M!W![!Y!](B") + ("{" "$(0!B!`!D(B " "$(G!B!`!D(B ") + ("}" "$(0!C!a!E(B" "$(G!C!a!E(B") + ("`" "$(0!j!k(B" "$(G!j!k(B") + ("~" "$(0"D"+",!<!=(B" "$(G"D"+",!<!=(B") + ("!" "$(0!*!5(B" "$(G!*!5(B") + ("@" "$(0"i"n(B" "$(G"i"n(B") + ("#" "$(0!l"-(B" "$(G!l"-(B") + ("$" "$(0"c"l(B" "$(G"c"l(B") + ("%" "$(0"h"m(B" "$(G"h"m(B") + ("&" "$(0!m".(B" "$(G!m".(B") + ("*" "$(0!n"/!o!w!x(B" "$(G!n"/!o!w!x(B") + ("(" "$(0!>!^!@(B" "$(G!>!^!@(B") + (")" "$(0!?!_!A(B" "$(G!?!_!A(B") + ("-" "$(0!7!9"#"$"1"@(B" "$(G!7!9"#"$"1"@(B") + ("_" "$(0"%"&(B" "$(G"%"&(B") + ("=" "$(0"8"C(B" "$(G"8"C(B") + ("+" "$(0"0"?(B" "$(G"0"?(B")))) (dolist (elt punctuation) (insert (format "(%S %S)\n" (concat "z" (car elt)) (if big5-p (nth 1 elt) (nth 2 elt)))))) @@ -850,11 +850,11 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." (defun py-converter (dicbuf) (goto-char (point-max)) - (insert (format "%S\n" "汉å—输入∷拼音∷ + (insert (format "%S\n" "$A::WVJdHk!KF4Rt!K(B - 拼音方案 + $AF4Rt7=08(B - å°å†™è‹±æ–‡å—æ¯ä»£è¡¨ã€Œæ‹¼éŸ³ã€ç¬¦å·ï¼Œ \"u(yu) 则用 u: 表示∶ + $AP!P4S"NDWVD84z1m!8F4Rt!97{:E#,(B \"u(yu) $ATrSC(B u: $A1mJ>!C(B Pinyin base input method for Chinese charset GB2312 (`chinese-gb2312'). @@ -868,14 +868,14 @@ character. The sequence is made by the combination of the initials iang ing iong u ua uo uai ui uan un uan ueng yu yue yuan yun (Note: In the correct Pinyin writing, the sequence \"yu\" in the last - four finals should be written by the character u-umlaut `ü'.) + four finals should be written by the character u-umlaut `$A(9(B'.) With this input method, you enter a Chinese character by first entering its pinyin spelling. \\<quail-translation-docstring> -For instance, to input ä½ , you type \"n i C-n 3\". The first \"n i\" +For instance, to input $ADc(B, you type \"n i C-n 3\". The first \"n i\" is a Pinyin, \"C-n\" selects the next group of candidates (each group contains at most 10 characters), \"3\" select the third character in that group. @@ -958,22 +958,22 @@ method `chinese-tonepy' with which you must specify tones by digits table))) (setq dic (sort dic (function (lambda (x y) (string< (car x) (car y)))))) (goto-char (point-max)) - (insert (format "%S\n" "汉å—输入∷ã€è‡ªç„¶ã€‘∷ - - 键盘对照表: - â”â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┳â”â”┓ - ┃Ｑ ┃Ｗ ┃Ｅ ┃Ｒ ┃Ｔ ┃Ｙ ┃Ｕsh┃Ｉch┃Ｏ ┃Ｐ ┃ - ┃ iu┃ ua┃ e┃ uan┃ ue┃ uai┃ u┃ i┃ o┃ un┃ - ┃ ┃ ia┃ ┃ van┃ ve┃ ing┃ ┃ ┃ uo┃ vn┃ - ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”› - ┃Ａ ┃Ｓ ┃Ｄ ┃Ｆ ┃Ｇ ┃Ｈ ┃Ｊ ┃Ｋ ┃Ｌ ┃ - ┃ a┃iong┃uang┃ en┃ eng┃ ang┃ an┃ ao┃ ai┃ - ┃ ┃ ong┃iang┃ ┃ ng┃ ┃ ┃ ┃ ┃ - ┗┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”┻┳â”â”┓ - ┃Ｚ ┃Ｘ ┃Ｃ ┃Ｖzh┃Ｂ ┃Ｎ â”ƒï¼ â”ƒï¼Œ ┃． ┃ ï¼ â”ƒ - ┃ ei┃ ie┃ iao┃ ui┃ ou┃ in┃ ian┃å‰é¡µâ”ƒåŽé¡µâ”ƒç¬¦å·â”ƒ - ┃ ┃ ┃ ┃ v┃ ┃ ┃ ┃ ┃ ┃ ┃ - â”—â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”»â”â”â”› + (insert (format "%S\n" "$A::WVJdHk!K!>WTH;!?!K(B + + $A<|EL6TUU1m(B: + $A)3)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)W)%)%)7(B + $A)'#Q(B $A)'#W(B $A)'#E(B $A)'#R(B $A)'#T(B $A)'#Y(B $A)'#U(Bsh$A)'#I(Bch$A)'#O(B $A)'#P(B $A)'(B + $A)'(B iu$A)'(B ua$A)'(B e$A)'(B uan$A)'(B ue$A)'(B uai$A)'(B u$A)'(B i$A)'(B o$A)'(B un$A)'(B + $A)'(B $A)'(B ia$A)'(B $A)'(B van$A)'(B ve$A)'(B ing$A)'(B $A)'(B $A)'(B uo$A)'(B vn$A)'(B + $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)?(B + $A)'#A(B $A)'#S(B $A)'#D(B $A)'#F(B $A)'#G(B $A)'#H(B $A)'#J(B $A)'#K(B $A)'#L(B $A)'(B + $A)'(B a$A)'(Biong$A)'(Buang$A)'(B en$A)'(B eng$A)'(B ang$A)'(B an$A)'(B ao$A)'(B ai$A)'(B + $A)'(B $A)'(B ong$A)'(Biang$A)'(B $A)'(B ng$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B + $A);)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)_)W)%)%)7(B + $A)'#Z(B $A)'#X(B $A)'#C(B $A)'#V(Bzh$A)'#B(B $A)'#N(B $A)'#M(B $A)'#,(B $A)'#.(B $A)'(B $A#/(B $A)'(B + $A)'(B ei$A)'(B ie$A)'(B iao$A)'(B ui$A)'(B ou$A)'(B in$A)'(B ian$A)'G0R3)':sR3)'7{:E)'(B + $A)'(B $A)'(B $A)'(B $A)'(B v$A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B $A)'(B + $A);)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)_)%)%)?(B Pinyin base input method for Chinese GB2312 characters (`chinese-gb2312'). @@ -985,34 +985,34 @@ method `chinese-py'. Unlike the standard spelling of Pinyin, in this input method all initials and finals are assigned to single keys (see the above table). For instance, the initial \"ch\" is assigned to the key `i', the final -\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and 轻声 are +\"iu\" is assigned to the key `q', and tones 1, 2, 3, 4, and $AGaIy(B are assigned to the keys `q', `w', `e', `r', `t' respectively. \\<quail-translation-docstring> To input one-letter words, you type 4 keys, the first two for the Pinyin of the letter, next one for tone, and the last one is always a -quote ('). For instance, \"vsq'\" input ä¸. Exceptions are these +quote ('). For instance, \"vsq'\" input $AVP(B. Exceptions are these letters. You can input them just by typing a single key. - Character: 按 ä¸ æ¬¡ çš„ 二 å‘ ä¸ª å’Œ 出 åŠ å¯ äº† 没 + Character: $A04(B $A2;(B $A4N(B $A5D(B $A6~(B $A7"(B $A8v(B $A:M(B $A3v(B $A<0(B $A?I(B $AAK(B $AC;(B Key: a b c d e f g h i j k l m - Character: ä½ æ¬§ 片 七 人 三 ä»– 是 ç€ æˆ‘ å° ä¸€ 在 + Character: $ADc(B $AE7(B $AF,(B $AF_(B $AHK(B $AH}(B $AK{(B $AJG(B $AWE(B $ANR(B $AP!(B $AR;(B $ATZ(B Key: n o p q r s t u v w x y z To input two-letter words, you have two ways. One way is to type 4 keys, two for the first Pinyin, two for the second Pinyin. For -instance, \"vsgo\" inputs ä¸å›½. Another way is to type 3 keys: 2 +instance, \"vsgo\" inputs $AVP9z(B. Another way is to type 3 keys: 2 initials of two letters, and quote ('). For instance, \"vg'\" also -inputs ä¸å›½. +inputs $AVP9z(B. To input three-letter words, you type 4 keys: initials of three -letters, and the last is quote ('). For instance, \"bjy'2\" inputs 北 -äº¬é¸ (the last `2' is to select one of the candidates). +letters, and the last is quote ('). For instance, \"bjy'2\" inputs $A11(B +$A>)Q<(B (the last `2' is to select one of the candidates). To input words of more than three letters, you type 4 keys, initials of the first three letters and the last letter. For instance, -\"bjdt\" inputs 北京电视å°. +\"bjdt\" inputs $A11>)5gJSL((B. To input symbols and punctuation, type `/' followed by one of `a' to `z', then select one of the candidates.")) @@ -1059,7 +1059,7 @@ To input symbols and punctuation, type `/' followed by one of `a' to ;; which the file is converted have no Big5 equivalent. Go ;; through and delete them. (goto-char pos) - (while (search-forward "â–¡" nil t) + (while (search-forward "$(0!{(B" nil t) (delete-char -1)) ;; Uppercase keys in dictionary need to be downcased. Backslashes ;; at the beginning of keys need to be turned into double @@ -1083,31 +1083,31 @@ To input symbols and punctuation, type `/' followed by one of `a' to (defun ctlau-gb-converter (dicbuf) (ctlau-converter dicbuf -"汉å—输入∷刘锡祥å¼ç²¤éŸ³âˆ· +"$A::WVJdHk!KAuN}OiJ=TARt!K(B - 刘锡祥å¼ç²¤è¯æ³¨éŸ³æ–¹æ¡ˆ + $AAuN}OiJ=TASoW"Rt7=08(B Sidney Lau's Cantonese transcription scheme as described in his book \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972. - This file was prepared by Fung Fung Lee (æŽæž«å³°). + This file was prepared by Fung Fung Lee ($A@n7c7e(B). Originally converted from CTCPS3.tit Last modified: June 2, 1993. Some infrequent GB characters are accessed by typing \\, followed by - the Cantonese romanization of the respective radical (部首).")) + the Cantonese romanization of the respective radical ($A2?JW(B).")) (defun ctlau-b5-converter (dicbuf) (ctlau-converter dicbuf -"æ¼¢å—輸入：劉錫祥å¼ç²µéŸ³ï¼š +"$(0KH)tTT&,!(N,Tg>A*#Gn5x!((B - 劉錫祥å¼ç²µèªžæ³¨éŸ³æ–¹æ¡ˆ + $(0N,Tg>A*#GnM$0D5x'J7{(B Sidney Lau's Cantonese transcription scheme as described in his book \"Elementary Cantonese\", The Government Printer, Hong Kong, 1972. - This file was prepared by Fung Fung Lee (æŽæ¥“å³°). + This file was prepared by Fung Fung Lee ($(0,XFS76(B). Originally converted from CTCPS3.tit Last modified: June 2, 1993. Some infrequent characters are accessed by typing \\, followed by - the Cantonese romanization of the respective radical (部首).")) + the Cantonese romanization of the respective radical ($(0?f5}(B).")) (declare-function dos-8+3-filename "dos-fns.el" (filename)) diff --git a/lisp/json.el b/lisp/json.el index 18d7fda8822..055f3f5be11 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -227,6 +227,7 @@ Unlike `reverse', this keeps the property-value pairs intact." (define-error 'json-string-format "Bad string format" 'json-error) (define-error 'json-key-format "Bad JSON object key" 'json-error) (define-error 'json-object-format "Bad JSON object" 'json-error) +(define-error 'json-array-format "Bad JSON array" 'json-error) (define-error 'json-end-of-file "End of file while parsing JSON" '(end-of-file json-error)) @@ -640,7 +641,7 @@ become JSON objects." (when (/= (json-peek) ?\]) (if (= (json-peek) ?,) (json-advance) - (signal 'json-error (list 'bleah))))) + (signal 'json-array-format (list ?, (json-peek)))))) ;; Skip over the "]" (json-advance) (pcase json-array-type diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 240e02e72f9..2246e5f6eaf 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -7626,7 +7626,6 @@ Hooks (use \\[describe-variable] to see their documentation): `dired-before-readin-hook' `dired-after-readin-hook' `dired-mode-hook' - `dired-load-hook' Keybindings: \\{dired-mode-map} @@ -8965,7 +8964,7 @@ an EDE controlled project. ;;;;;; "cedet/ede/cpp-root.el" (0 0 0 0)) ;;; Generated autoloads from cedet/ede/cpp-root.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/cpp-root" '("ede-c"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ede/cpp-root" '("ede-cpp-root-"))) ;;;*** @@ -17138,7 +17137,6 @@ The main features of this mode are 8. Hooks ----- - Loading idlwave.el runs `idlwave-load-hook'. Turning on `idlwave-mode' runs `idlwave-mode-hook'. 9. Documentation and Customization @@ -19811,7 +19809,7 @@ This function is suitable for execution in an init file. \(fn &optional ARG)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "lunar-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "lunar" '("calendar-lunar-phases" "diary-lunar-phases" "eclipse-check" "lunar-"))) ;;;*** @@ -24718,8 +24716,9 @@ matching parenthesis is highlighted in `show-paren-style' after (autoload 'parse-time-string "parse-time" "\ Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -STRING should be something resembling an RFC 822 (or later) date-time, e.g., -\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is +STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\", +or something resembling an RFC 822 (or later) date-time, e.g., +\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is somewhat liberal in what format it accepts, and will attempt to return a \"likely\" value even for somewhat malformed strings. The values returned are identical to those of `decode-time', but @@ -28651,6 +28650,14 @@ For more details, see Info node `(elisp) Extending Rx'. ;;;*** +;;;### (autoloads nil "sasl-scram-sha256" "net/sasl-scram-sha256.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from net/sasl-scram-sha256.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sasl-scram-sha256" '("sasl-scram-sha"))) + +;;;*** + ;;;### (autoloads nil "savehist" "savehist.el" (0 0 0 0)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) @@ -28752,13 +28759,6 @@ file: ;;;*** -;;;### (autoloads nil "sb-image" "sb-image.el" (0 0 0 0)) -;;; Generated autoloads from sb-image.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "sb-image" '("defimage-speedbar" "speedbar-"))) - -;;;*** - ;;;### (autoloads nil "scheme" "progmodes/scheme.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/scheme.el @@ -34466,7 +34466,7 @@ the output buffer or changing the window configuration. ;;;### (autoloads nil "tramp" "net/tramp.el" (0 0 0 0)) ;;; Generated autoloads from net/tramp.el -(push (purecopy '(tramp 2 4 3)) package--builtin-versions) +(push (purecopy '(tramp 2 5 0 -1)) package--builtin-versions) (defvar tramp-mode t "\ Whether Tramp is enabled. @@ -34496,18 +34496,15 @@ match file names at root of the underlying local file system, like \"/sys\" or \"/C:\".") (defun tramp-autoload-file-name-handler (operation &rest args) "\ -Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (if tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) +Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) (defun tramp-register-autoload-file-name-handlers nil "\ -Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put 'tramp-autoload-file-name-handler 'safe-magic t)) +Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) (tramp-register-autoload-file-name-handlers) (defun tramp-unload-file-name-handlers nil "\ Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh file-name-handler-alist) (when (and (symbolp (cdr fnh)) (string-prefix-p "tramp-" (symbol-name (cdr fnh)))) (setq file-name-handler-alist (delq fnh file-name-handler-alist))))) -(defvar tramp-completion-mode nil "\ -If non-nil, external packages signal that they are in file name completion.") - (defun tramp-unload-tramp nil "\ Discard Tramp from loading remote files." (interactive) (ignore-errors (unload-feature 'tramp 'force))) @@ -34543,7 +34540,7 @@ Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (defalias 'tramp-archive-autoload-file-name-handler #'tramp-autoload-file-name-handler) (defun tramp-register-archive-file-name-handler nil "\ -Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put 'tramp-archive-autoload-file-name-handler 'safe-magic t))) +Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler) @@ -38846,10 +38843,19 @@ Zone out, completely." t nil) ;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el" ;;;;;; "files.el" "font-core.el" "font-lock.el" "format.el" "frame.el" ;;;;;; "help.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" -;;;;;; "international/charscript.el" "international/cp51932.el" -;;;;;; "international/eucjp-ms.el" "international/mule-cmds.el" -;;;;;; "international/mule-conf.el" "international/mule.el" "isearch.el" -;;;;;; "jit-lock.el" "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" +;;;;;; "international/charprop.el" "international/charscript.el" +;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/mule-cmds.el" +;;;;;; "international/mule-conf.el" "international/mule.el" "international/uni-bidi.el" +;;;;;; "international/uni-brackets.el" "international/uni-category.el" +;;;;;; "international/uni-combining.el" "international/uni-comment.el" +;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" +;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" +;;;;;; "international/uni-mirrored.el" "international/uni-name.el" +;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" +;;;;;; "international/uni-special-lowercase.el" "international/uni-special-titlecase.el" +;;;;;; "international/uni-special-uppercase.el" "international/uni-titlecase.el" +;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el" +;;;;;; "jka-cmpr-hook.el" "language/burmese.el" "language/cham.el" ;;;;;; "language/chinese.el" "language/cyrillic.el" "language/czech.el" ;;;;;; "language/english.el" "language/ethiopic.el" "language/european.el" ;;;;;; "language/georgian.el" "language/greek.el" "language/hebrew.el" diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 35a9adbe29b..78ffca9e2fa 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -727,7 +727,9 @@ system, including many technical ones. Examples: ("\\ldq" ?\“) ("\\rdq" ?\â€) ("\\defs" ?≙) ; per fuzz/zed - ;; ("\\sqrt[3]" ?∛) + ("\\sqrt" ?√) + ("\\sqrt[3]" ?∛) + ("\\sqrt[4]" ?∜) ("\\llbracket" ?\〚) ; stmaryrd ("\\rrbracket" ?\〛) ;; ("\\lbag" ?\〚) ; fuzz diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index b9920023d82..0d7193c1be0 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1203,7 +1203,7 @@ no longer matches to transformed string. Used by function feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker." :version "24.1" :group 'feedmail-queue - :type 'string + :type 'regexp ) diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index 1755f4eb467..db518482591 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -133,7 +133,7 @@ If any element matches the \"From\" header, the message is flagged as a valid, non-spam message. E.g., if your domain is \"emacs.com\" then including \"emacs\\\\.com\" in this list would flag all mail (purporting to be) from your colleagues as valid." - :type '(repeat string) + :type '(repeat regexp) :group 'rmail-spam-filter) (defcustom rsf-definitions-alist nil @@ -157,22 +157,22 @@ A rule matches only if all the specified elements match." (list :format "%v" (cons :format "%v" :value (from . "") (const :format "" from) - (string :tag "From" "")) + (regexp :tag "From" "")) (cons :format "%v" :value (to . "") (const :format "" to) - (string :tag "To" "")) + (regexp :tag "To" "")) (cons :format "%v" :value (subject . "") (const :format "" subject) - (string :tag "Subject" "")) + (regexp :tag "Subject" "")) (cons :format "%v" :value (content-type . "") (const :format "" content-type) - (string :tag "Content-Type" "")) + (regexp :tag "Content-Type" "")) (cons :format "%v" :value (contents . "") (const :format "" contents) - (string :tag "Contents" "")) + (regexp :tag "Contents" "")) (cons :format "%v" :value (x-spam-status . "") (const :format "" x-spam-status) - (string :tag "X-Spam-Status" "")) + (regexp :tag "X-Spam-Status" "")) (cons :format "%v" :value (action . output-and-delete) (const :format "" action) (choice :tag "Action selection" diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index d798ffa0516..d79cea987e9 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4392,9 +4392,8 @@ browsing, and moving of messages." (text face mouse function &optional token prevline)) ;; Make sure our special speedbar major mode is loaded -(if (featurep 'speedbar) - (rmail-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (rmail-install-speedbar-variables)) (defun rmail-speedbar-buttons (buffer) "Create buttons for BUFFER containing rmail messages. diff --git a/lisp/man.el b/lisp/man.el index 4406ac5d642..5278a1a84dd 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -253,7 +253,7 @@ the associated section number." "Regexp that matches the text that precedes the command's name. Used in `bookmark-set' to get the default bookmark name." :version "24.1" - :type 'string :group 'bookmark) + :type 'regexp :group 'bookmark) (defcustom manual-program "man" "Program used by `man' to produce man pages." diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 8f825a19adc..731da193ef1 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1476,6 +1476,18 @@ mail status in mode line")) (bindings--define-key menu [cursor-separator] menu-bar-separator) + (bindings--define-key menu [save-desktop] + (menu-bar-make-toggle + toggle-save-desktop-globally desktop-save-mode + "Save State between Sessions" + "Saving desktop state %s" + "Visit desktop of previous session when restarting Emacs" + (require 'desktop) + ;; Do it by name, to avoid a free-variable + ;; warning during byte compilation. + (set-default + 'desktop-save-mode (not (symbol-value 'desktop-save-mode))))) + (bindings--define-key menu [save-place] (menu-bar-make-toggle toggle-save-place-globally save-place-mode diff --git a/lisp/msb.el b/lisp/msb.el index ebaf98cbe83..15aeaa2e73f 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -372,6 +372,8 @@ This is instead of the groups in `msb-menu-cond'." :type 'hook :set 'msb-custom-set :group 'msb) +(make-obsolete-variable 'msb-after-load-hook + "use `with-eval-after-load' instead." "28.1") ;;; ;;; Internal variables diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 1d456044901..f28394260dd 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -838,7 +838,7 @@ If nil, prompt the user for a password." "If non-nil, regexp matching hosts on which `dir' command lists directory." :group 'ange-ftp :type '(choice (const :tag "Default" nil) - string)) + regexp)) (defcustom ange-ftp-binary-file-name-regexp "" "If a file matches this regexp then it is transferred in binary mode." diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 25aabf6d61d..7aad44b2876 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -216,7 +216,7 @@ be used instead." "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: ;; http://thread.gmane.org/47B4E3B2.3050402@gmail.com - "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" + "[" chars punct "]+" "(" "[" chars punct "]+" ")" "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" "\\|" "[" chars punct "]+" "[" chars "]" diff --git a/lisp/net/dns.el b/lisp/net/dns.el index cefe0851f03..78d48271629 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -258,10 +258,8 @@ If TCP-P, the first two bytes of the package with be the length field." (nreverse spec)))) (defun dns-read-int32 () - ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we - ;; use floats, it works. - (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0) - (dns-read-bytes 3)))) + (declare (obsolete nil "28.1")) + (number-to-string (dns-read-bytes 4))) (defun dns-read-type (string type) (let ((buffer (current-buffer)) @@ -286,11 +284,11 @@ If TCP-P, the first two bytes of the package with be the length field." ((eq type 'SOA) (list (list 'mname (dns-read-name buffer)) (list 'rname (dns-read-name buffer)) - (list 'serial (dns-read-int32)) - (list 'refresh (dns-read-int32)) - (list 'retry (dns-read-int32)) - (list 'expire (dns-read-int32)) - (list 'minimum (dns-read-int32)))) + (list 'serial (dns-read-bytes 4)) + (list 'refresh (dns-read-bytes 4)) + (list 'retry (dns-read-bytes 4)) + (list 'expire (dns-read-bytes 4)) + (list 'minimum (dns-read-bytes 4)))) ((eq type 'SRV) (list (list 'priority (dns-read-bytes 2)) (list 'weight (dns-read-bytes 2)) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 811d7c69209..c83884fd259 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1107,11 +1107,13 @@ just re-display the HTML already fetched." (defun eww-form-submit (dom) (let ((start (point)) (value (dom-attr dom 'value))) - (setq value - (if (zerop (length value)) - "Submit" - value)) - (insert value) + (if (null value) + (shr-generic dom) + (insert value)) + ;; If the contents of the <button>...</button> turns out to be + ;; empty, or the value was blank, default to this: + (when (= (point) start) + (insert "Submit")) (add-face-text-property start (point) 'eww-form-submit) (put-text-property start (point) 'eww-form (list :eww-form eww-form diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index e42a7655ef3..700653250fb 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -727,7 +727,7 @@ an alist of attribute/value pairs." (setq record nil) (skip-chars-forward " \t\n") (message "Parsing results... %d" numres) - (1+ numres)) + (setq numres (1+ numres))) (message "Parsing results... done") (nreverse result))))) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index eb61d7a6796..b8f1bccd788 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -363,7 +363,7 @@ description are marked as immortal." (const :tag "Title" title) (const :tag "Description" description) (const :tag "All" all)) - (string :tag "Regexp"))))) + (regexp :tag "Regexp"))))) :group 'newsticker-headline-processing) ;; ====================================================================== diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index e94947bc7f1..2d36c5e2571 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -311,9 +311,9 @@ See also: `network-security-protocol-checks' and `nsm-noninteractive'" (map-values results) "\n") "\n") - "\n* "))))) - (delete-process process) - (setq process nil))) + "\n* ")))))) + (delete-process process) + (setq process nil)) (run-hook-with-args 'nsm-tls-post-check-functions host port status settings results))) process) @@ -371,7 +371,7 @@ Reference: Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure Use of Transport Layer Security (TLS) and Datagram Transport Layer Security (DTLS)\", \"(4.1. General Guidelines)\" -`https://tools.ietf.org/html/rfc7525\#section-4.1'" +`https://tools.ietf.org/html/rfc7525#section-4.1'" (let ((kx (plist-get status :key-exchange))) (and (string-match "^\\bRSA\\b" kx) (format-message @@ -468,7 +468,7 @@ Reference: GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous authentication\", -`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'" +`https://www.gnutls.org/manual/gnutls.html#Anonymous-authentication'" (let ((kx (plist-get status :key-exchange))) (and (string-match "\\bANON\\b" kx) (format-message @@ -603,7 +603,7 @@ References: full SHA-1\", `https://shattered.io/static/shattered.pdf' [2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed Features (SHA-1 Certificate Signatures)\", -`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures' +`https://www.chromium.org/Home/chromium-security/education/tls#TOC-SHA-1-Certificate-Signatures' [3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\", `https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/' [4]: Apple Support (2017). \"Move to SHA-256 signed certificates to diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index fff640bb675..a2234166903 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -254,7 +254,7 @@ Examples: (\"bitlbee\" bitlbee \"robert\" \"sekrit\") (\"dal.net\" nickserv \"bob\" \"sekrit\" \"NickServ@services.dal.net\") (\"quakenet.org\" quakenet \"bobby\" \"sekrit\"))" - :type '(alist :key-type (string :tag "Server") + :type '(alist :key-type (regexp :tag "Server") :value-type (choice (list :tag "NickServ" (const nickserv) (string :tag "Nick") @@ -359,9 +359,9 @@ If VAL is a coding system, it is used for both decoding and encoding messages. If VAL is a cons of coding systems, the car part is used for decoding, and the cdr part is used for encoding." - :type '(alist :key-type (choice (string :tag "Channel Regexp") - (cons (string :tag "Channel Regexp") - (string :tag "Server Regexp"))) + :type '(alist :key-type (choice (regexp :tag "Channel Regexp") + (cons (regexp :tag "Channel Regexp") + (regexp :tag "Server Regexp"))) :value-type (choice coding-system (cons (coding-system :tag "Decode") (coding-system :tag "Encode"))))) @@ -2421,7 +2421,7 @@ keywords when no KEYWORD is given." (concat "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: - "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "[" chars "]" + "[" chars punct "]+" "(" "[" chars punct "]+" ")" "[" chars "]" "\\|" "[" chars punct "]+" "[" chars "]" "\\)")) diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el new file mode 100644 index 00000000000..e50a032c233 --- /dev/null +++ b/lisp/net/sasl-scram-sha256.el @@ -0,0 +1,59 @@ +;;; sasl-scram-sha256.el --- SCRAM-SHA-256 module for the SASL client framework -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <simon@josefsson.org> +;; Package: sasl + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Implement the SCRAM-SHA-256 mechanism from RFC 7677. + +;;; Code: + +(require 'cl-lib) +(require 'sasl) +(require 'hex-util) +(require 'rfc2104) +(require 'sasl-scram-rfc) + +;;; SCRAM-SHA-256 + +(defconst sasl-scram-sha-256-steps + '(sasl-scram-client-first-message + sasl-scram-sha-256-client-final-message + sasl-scram-sha-256-authenticate-server)) + +(defun sasl-scram-sha256 (object &optional start end binary) + (secure-hash 'sha256 object start end binary)) + +(defun sasl-scram-sha-256-client-final-message (client step) + (sasl-scram--client-final-message + ;; HMAC-SHA256 uses block length 64 and hash length 32; see RFC 4634. + 'sasl-scram-sha256 64 32 client step)) + +(defun sasl-scram-sha-256-authenticate-server (client step) + (sasl-scram--authenticate-server + 'sasl-scram-sha256 64 32 client step)) + +(put 'sasl-scram-sha256 'sasl-mechanism + (sasl-make-mechanism "SCRAM-SHA-256" sasl-scram-sha-256-steps)) + +(provide 'sasl-scram-sha256) + +;;; sasl-scram-sha256.el ends here diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 4405c904cd3..ab118e1f982 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -35,8 +35,8 @@ ;;; Code: (defvar sasl-mechanisms - '("SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS" - "NTLM")) + '("SCRAM-SHA-256" "SCRAM-SHA-1" "CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" + "ANONYMOUS" "NTLM")) (defvar sasl-mechanism-alist '(("CRAM-MD5" sasl-cram) @@ -45,6 +45,7 @@ ("LOGIN" sasl-login) ("ANONYMOUS" sasl-anonymous) ("NTLM" sasl-ntlm) + ("SCRAM-SHA-256" sasl-scram-sha256) ("SCRAM-SHA-1" sasl-scram-rfc))) (defvar sasl-unique-id-function #'sasl-unique-id-function) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 241180d471a..1f80ab74db5 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -838,7 +838,7 @@ size, and full-buffer size." ;; Always chop off anchors. (when (string-match "#.*" url) (setq url (substring url 0 (match-beginning 0)))) - ;; NB: <base href="" > URI may itself be relative to the document s URI + ;; NB: <base href=""> URI may itself be relative to the document's URI. (setq url (shr-expand-url url)) (let* ((parsed (url-generic-parse-url url)) (local (url-filename parsed))) @@ -1265,7 +1265,9 @@ START, and END. Note that START and END should be markers." (format "%s (%s)" iri title) iri)) 'follow-link t - 'mouse-face 'highlight)) + ;; Make separate regions not `eq' so that they'll get + ;; separate mouse highlights. + 'mouse-face (list 'highlight))) ;; Don't overwrite any keymaps that are already in the buffer (i.e., ;; image keymaps). (while (and start @@ -1438,7 +1440,7 @@ ones, in case fg and bg are nil." (shr-fontize-dom dom 'underline)) (defun shr-tag-code (dom) - (let ((shr-current-font 'default)) + (let ((shr-current-font 'fixed-pitch)) (shr-generic dom))) (defun shr-tag-tt (dom) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 5cfcb81708f..aa7fe147c20 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -181,10 +181,9 @@ It is used for TCP/IP devices." "Invoke the ADB handler for OPERATION. First arg specifies the OPERATION, second arg is a list of ARGUMENTS to pass to the OPERATION." - (let ((fn (assoc operation tramp-adb-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) arguments)) - (tramp-run-real-handler operation arguments)))) + (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist))) + (save-match-data (apply (cdr fn) arguments)) + (tramp-run-real-handler operation arguments))) ;;;###tramp-autoload (tramp--with-startup @@ -234,8 +233,7 @@ ARGUMENTS to pass to the OPERATION." "Like `file-truename' for Tramp files." ;; Preserve trailing "/". (funcall - (if (tramp-compat-directory-name-p filename) - #'file-name-as-directory #'identity) + (if (directory-name-p filename) #'file-name-as-directory #'identity) ;; Quote properly. (funcall (if (tramp-compat-file-name-quoted-p filename) @@ -719,14 +717,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter v 0 (format "Copying %s to %s" filename newname) (if (and t1 t2 (tramp-equal-remote filename newname)) - (let ((l1 (tramp-compat-file-local-name filename)) - (l2 (tramp-compat-file-local-name newname))) + (let ((l1 (tramp-file-local-name filename)) + (l2 (tramp-file-local-name newname))) ;; We must also flush the cache of the directory, ;; because `file-attributes' reads the values from ;; there. @@ -739,39 +737,37 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (tramp-shell-quote-argument l2)) "Error copying %s to %s" filename newname)) - (let ((tmpfile (file-local-copy filename))) - - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. - (when (and (file-directory-p newname) - (tramp-compat-directory-name-p newname)) - (setq newname - (expand-file-name - (file-name-nondirectory filename) newname))) - - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) - (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - - ;; We must also flush the cache of the directory, - ;; because `file-attributes' reads the values from - ;; there. - (tramp-flush-file-properties v localname) - (when (tramp-adb-execute-adb-command - v "push" - (tramp-compat-file-name-unquote filename) - (tramp-compat-file-name-unquote localname)) - (tramp-error - v 'file-error - "Cannot copy `%s' `%s'" filename newname))))))))) + (if-let ((tmpfile (file-local-copy filename))) + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (and (file-directory-p newname) + (directory-name-p newname)) + (setq newname + (expand-file-name + (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + ;; We must also flush the cache of the directory, + ;; because `file-attributes' reads the values from + ;; there. + (tramp-flush-file-properties v localname) + (when (tramp-adb-execute-adb-command + v "push" + (tramp-compat-file-name-unquote filename) + (tramp-compat-file-name-unquote localname)) + (tramp-error + v 'file-error + "Cannot copy `%s' `%s'" filename newname)))))))) ;; KEEP-DATE handling. (when keep-date @@ -801,7 +797,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter @@ -809,8 +805,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (if (and t1 t2 (tramp-equal-remote filename newname) (not (file-directory-p filename))) - (let ((l1 (tramp-compat-file-local-name filename)) - (l2 (tramp-compat-file-local-name newname))) + (let ((l1 (tramp-file-local-name filename)) + (l2 (tramp-file-local-name newname))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-properties v l1) @@ -846,7 +842,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq infile (expand-file-name infile)) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) + (setq input (tramp-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -877,8 +873,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (with-parsed-tramp-file-name - (cadr destination) nil localname)) + (setq stderr (tramp-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -936,6 +931,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. +;; The complete STDERR buffer is available only when the process has +;; terminated. (defun tramp-adb-handle-make-process (&rest args) "Like `make-process' for Tramp files." (when args @@ -969,17 +966,29 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" stderr))) (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) (args (cdr command)) (command - (format "cd %s && exec %s" + (format "cd %s && exec %s %s" (tramp-shell-quote-argument localname) + (if tmpstderr (format "2>'%s'" tmpstderr) "") (mapconcat #'tramp-shell-quote-argument (cons program args) " "))) (tramp-process-connection-type @@ -1029,6 +1038,18 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) + ;; We must flush them here already; otherwise + ;; `rename-file', `delete-file' or + ;; `insert-file-contents' will fail. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) ;; Read initial output. Remove the first line, ;; which is the command echo. (while @@ -1037,6 +1058,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (not (re-search-forward "[\n]" nil t))) (tramp-accept-process-output p 0)) (delete-region (point-min) (point)) + ;; Provide error buffer. This shows only + ;; initial error messages; messages arriving + ;; later on will be inserted when the process + ;; is deleted. The temporary file will exist + ;; until the process is deleted. + (when (bufferp stderr) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit)) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr)))) ;; Return process. p)))) @@ -1062,7 +1100,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (read (current-buffer))) ":" 'omit))) ;; The equivalent to `exec-directory'. - `(,(tramp-compat-file-local-name default-directory)))) + `(,(tramp-file-local-name (expand-file-name default-directory))))) (defun tramp-adb-get-device (vec) "Return full host name from VEC to be used in shell execution. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index b9bf6180a5d..95cbfb8c22a 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -350,7 +350,7 @@ arguments to pass to the OPERATION." (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) - (put 'tramp-archive-autoload-file-name-handler 'safe-magic t)))) + (put #'tramp-archive-autoload-file-name-handler 'safe-magic t)))) ;;;###autoload (progn @@ -366,7 +366,7 @@ arguments to pass to the OPERATION." (tramp-register-archive-file-name-handler) ;; Mark `operations' the handler is responsible for. -(put 'tramp-archive-file-name-handler 'operations +(put #'tramp-archive-file-name-handler 'operations (mapcar #'car tramp-archive-file-name-handler-alist)) ;; `tramp-archive-file-name-handler' must be placed before `url-file-handler'. @@ -517,13 +517,16 @@ offered." (declare (debug (form symbolp body)) (indent 2)) (let ((bindings - (mapcar (lambda (elem) - `(,(if var (intern (format "%s-%s" var elem)) elem) - (,(intern (format "tramp-file-name-%s" elem)) - ,(or var 'v)))) - `,(cons - 'archive - (delete 'hop (tramp-compat-tramp-file-name-slots)))))) + (mapcar + (lambda (elem) + `(,(if var (intern (format "%s-%s" var elem)) elem) + (,(intern (format "tramp-file-name-%s" elem)) + ,(or var 'v)))) + (cons + 'archive + (delete + 'hop + (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))))))) `(let* ((,(or var 'v) (tramp-archive-dissect-file-name ,filename)) ,@bindings) ;; We don't know which of those vars will be used, so we bind them all, diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 62e25fa1f08..91ed5465695 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -130,13 +130,8 @@ Returns DEFAULT if not set." (or (null remote-file-name-inhibit-cache) (and (integerp remote-file-name-inhibit-cache) (time-less-p - ;; `current-time' can be nil once we get rid of Emacs 24. - (current-time) - (time-add - (car value) - ;; `seconds-to-time' can be removed once we get - ;; rid of Emacs 24. - (seconds-to-time remote-file-name-inhibit-cache)))) + nil + (time-add (car value) remote-file-name-inhibit-cache))) (and (consp remote-file-name-inhibit-cache) (time-less-p remote-file-name-inhibit-cache (car value))))) @@ -146,7 +141,7 @@ Returns DEFAULT if not set." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (bound-and-true-p var) + (val (or (numberp (bound-and-true-p var)) (progn (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) @@ -170,7 +165,7 @@ Returns VALUE." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (bound-and-true-p var) + (val (or (numberp (bound-and-true-p var)) (progn (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) @@ -202,13 +197,11 @@ Returns VALUE." key (copy-tramp-file-name key)) (setf (tramp-file-name-localname key) file (tramp-file-name-hop key) nil) - (maphash - (lambda (property _value) - (when (string-match-p - "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" - property) - (tramp-flush-file-property key file property))) - (tramp-get-hash-table key))))) + (dolist (property (hash-table-keys (tramp-get-hash-table key))) + (when (string-match-p + "^\\(directory-\\|file-name-all-completions\\|file-entries\\)" + property) + (tramp-flush-file-property key file property)))))) ;;;###tramp-autoload (defun tramp-flush-file-properties (key file) @@ -239,14 +232,12 @@ Remove also properties of all files in subdirectories." #'directory-file-name (list directory))) (truename (tramp-get-file-property key directory "file-truename" nil))) (tramp-message key 8 "%s" directory) - (maphash - (lambda (key _value) - (when (and (tramp-file-name-p key) - (stringp (tramp-file-name-localname key)) - (string-match-p (regexp-quote directory) - (tramp-file-name-localname key))) - (remhash key tramp-cache-data))) - tramp-cache-data) + (dolist (key (hash-table-keys tramp-cache-data)) + (when (and (tramp-file-name-p key) + (stringp (tramp-file-name-localname key)) + (string-match-p (regexp-quote directory) + (tramp-file-name-localname key))) + (remhash key tramp-cache-data))) ;; Remove file properties of symlinks. (when (and (stringp truename) (not (string-equal directory (directory-file-name truename)))) @@ -370,11 +361,8 @@ used to cache connection properties of the local machine." (tramp-file-name-hop key) nil)) (tramp-message key 7 "%s %s" key - (let ((hash (gethash key tramp-cache-data)) - properties) - (when (hash-table-p hash) - (maphash (lambda (x _y) (push x properties)) hash)) - properties)) + (let ((hash (gethash key tramp-cache-data))) + (when (hash-table-p hash) (hash-table-keys hash)))) (setq tramp-cache-data-changed t) (remhash key tramp-cache-data)) @@ -386,20 +374,15 @@ used to cache connection properties of the local machine." (maphash (lambda (key value) ;; Remove text properties from KEY and VALUE. - ;; `cl-struct-slot-*' functions exist since Emacs 25 only; we - ;; ignore errors. (when (tramp-file-name-p key) - ;; (dolist - ;; (slot - ;; (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name)))) - ;; (when (stringp (cl-struct-slot-value 'tramp-file-name slot key)) - ;; (setf (cl-struct-slot-value 'tramp-file-name slot key) - ;; (substring-no-properties - ;; (cl-struct-slot-value 'tramp-file-name slot key)))))) - (dotimes (i (length key)) - (when (stringp (elt key i)) - (setf (elt key i) (substring-no-properties (elt key i)))))) - (when (stringp key) + (dolist + (slot + (mapcar #'car (cdr (cl-struct-slot-info 'tramp-file-name)))) + (when (stringp (cl-struct-slot-value 'tramp-file-name slot key)) + (setf (cl-struct-slot-value 'tramp-file-name slot key) + (substring-no-properties + (cl-struct-slot-value 'tramp-file-name slot key)))))) + (when (stringp key) (setq key (substring-no-properties key))) (when (stringp value) (setq value (substring-no-properties value))) @@ -421,15 +404,14 @@ used to cache connection properties of the local machine." ;;;###tramp-autoload (defun tramp-list-connections () "Return all known `tramp-file-name' structs according to `tramp-cache'." - (let (result tramp-verbose) - (maphash - (lambda (key _value) - (when (and (tramp-file-name-p key) - (null (tramp-file-name-localname key)) - (tramp-connection-property-p key "process-buffer")) - (push key result))) - tramp-cache-data) - result)) + (let ((tramp-verbose 0)) + (delq nil (mapcar + (lambda (key) + (and (tramp-file-name-p key) + (null (tramp-file-name-localname key)) + (tramp-connection-property-p key "process-buffer") + key)) + (hash-table-keys tramp-cache-data))))) (defun tramp-dump-connection-properties () "Write persistent connection properties into file `tramp-persistency-file-name'." @@ -490,17 +472,14 @@ used to cache connection properties of the local machine." "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' for all methods. Resulting data are derived from connection history." - (let (res) - (maphash - (lambda (key _value) - (if (and (tramp-file-name-p key) - (string-equal method (tramp-file-name-method key)) - (not (tramp-file-name-localname key))) - (push (list (tramp-file-name-user key) - (tramp-file-name-host key)) - res))) - tramp-cache-data) - res)) + (mapcar + (lambda (key) + (and (tramp-file-name-p key) + (string-equal method (tramp-file-name-method key)) + (not (tramp-file-name-localname key)) + (list (tramp-file-name-user key) + (tramp-file-name-host key)))) + (hash-table-keys tramp-cache-data))) ;; When "emacs -Q" has been called, both variables are nil. We do not ;; load the persistency file then, in order to have a clean test environment. @@ -514,7 +493,7 @@ for all methods. Resulting data are derived from connection history." tramp-cache-read-persistent-data) (condition-case err (with-temp-buffer - (insert-file-contents tramp-persistency-file-name) + (insert-file-contents-literally tramp-persistency-file-name) (let ((list (read (current-buffer))) (tramp-verbose 0) element key item) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 9d1025b9072..b4dca2321c1 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -358,7 +358,7 @@ The remote connection identified by SOURCE is flushed by ;; Append local file name if none is specified. (when (string-equal (file-remote-p target) target) - (setq target (concat target (file-remote-p source 'localname)))) + (setq target (concat target (tramp-file-local-name source)))) ;; Make them directory names. (setq source (directory-file-name source) target (directory-file-name target)) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 723b8cfa1e3..87bcd08b85a 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,15 +23,15 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 27. This -;; package provides compatibility functions for Emacs 24, Emacs 25 and -;; Emacs 26. +;; Tramp's main Emacs version for development is Emacs 28. This +;; package provides compatibility functions for Emacs 25, Emacs 26 and +;; Emacs 27. ;;; Code: -;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not -;; autoloaded. So we declare it here in order to avoid recursive -;; load. This will be overwritten in tramp.el. +;; In Emacs 25, `tramp-unload-file-name-handlers' is not autoloaded. +;; So we declare it here in order to avoid recursive load. This will +;; be overwritten in tramp.el. (defun tramp-unload-file-name-handlers () ".") (require 'auth-source) @@ -41,6 +41,7 @@ (require 'shell) (require 'subr-x) +;; `temporary-file-directory' as function is introduced with Emacs 26.1. (declare-function tramp-handle-temporary-file-directory "tramp") ;; For not existing functions, obsolete functions, or functions with a @@ -51,6 +52,8 @@ `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) +(put #'tramp-compat-funcall 'tramp-suppress-trace t) + (defsubst tramp-compat-temporary-file-directory () "Return name of directory for temporary files. It is the default value of `temporary-file-directory'." @@ -74,31 +77,7 @@ Add the extension of F, if existing." #'temporary-file-directory #'tramp-handle-temporary-file-directory)) -(defun tramp-compat-process-running-p (process-name) - "Return t if system process PROCESS-NAME is running for `user-login-name'." - (when (stringp process-name) - (cond - ;; GNU Emacs 22 on w32. - ((fboundp 'w32-window-exists-p) - (tramp-compat-funcall 'w32-window-exists-p process-name process-name)) - - ;; GNU Emacs 23+. - ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) - (let (result) - (dolist (pid (tramp-compat-funcall 'list-system-processes) result) - (let ((attributes (process-attributes pid))) - (when (and (string-equal - (cdr (assoc 'user attributes)) (user-login-name)) - (let ((comm (cdr (assoc 'comm attributes)))) - ;; The returned command name could be truncated - ;; to 15 characters. Therefore, we cannot check - ;; for `string-equal'. - (and comm (string-match-p - (concat "^" (regexp-quote comm)) - process-name)))) - (setq result t))))))))) - -;; `file-attribute-*' are introduced in Emacs 25.1. +;; `file-attribute-*' are introduced in Emacs 26.1. (defalias 'tramp-compat-file-attribute-type (if (fboundp 'file-attribute-type) @@ -180,24 +159,6 @@ and later, and is a float in Emacs 26 and earlier." This is a string of ten letters or dashes as in ls -l." (nth 8 attributes)))) -;; `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. -(defalias 'tramp-compat-directory-name-p - (if (fboundp 'directory-name-p) - #'directory-name-p - (lambda (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) @@ -265,13 +226,6 @@ NAME is unquoted." ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) -;; `cl-struct-slot-info' has been introduced with Emacs 25. -(defmacro tramp-compat-tramp-file-name-slots () - "Return a list of slot names." - (if (fboundp 'cl-struct-slot-info) - '(cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name))) - '(cdr (mapcar #'car (get 'tramp-file-name 'cl-struct-slots))))) - ;; The signature of `tramp-make-tramp-file-name' has been changed. ;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior ;; Emacs 26.1. We use `temporary-file-directory' as indicator. @@ -284,10 +238,9 @@ NAME is unquoted." #'exec-path (lambda () "List of directories to search programs to run in remote subprocesses." - (let ((handler (find-file-name-handler default-directory 'exec-path))) - (if handler - (funcall handler 'exec-path) - exec-path))))) + (if-let ((handler (find-file-name-handler default-directory 'exec-path))) + (funcall handler 'exec-path) + exec-path)))) ;; `time-equal-p' has appeared in Emacs 27.1. (defalias 'tramp-compat-time-equal-p @@ -327,11 +280,11 @@ A nil value for either argument stands for the current time." (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) +(provide 'tramp-compat) + ;;; TODO: ;; -;; * Starting with Emacs 25.1, replace `tramp-message-show-message' by -;; the reverse of `inhibit-message'. - -(provide 'tramp-compat) +;; * Starting with Emacs 27.1, there's no need to escape open +;; parentheses with a backslash in docstrings anymore. ;;; tramp-compat.el ends here diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 34a234c47f0..762c4fe4b3b 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,11 +49,15 @@ ;; The user option `tramp-gvfs-methods' contains the list of supported ;; connection methods. Per default, these are "afp", "dav", "davs", -;; "gdrive", "nextcloud" and "sftp". +;; "gdrive", "media", "nextcloud" and "sftp". ;; "gdrive" and "nextcloud" connection methods require a respective ;; account in GNOME Online Accounts, with enabled "Files" service. +;; The "media" connection method is responsible for media devices, +;; like cell phones, tablets, cameras etc. The device must already be +;; connected via USB, before accessing it. + ;; Other possible connection methods are "ftp", "http", "https" and ;; "smb". When one of these methods is added to the list, the remote ;; access for that method is performed via GVFS instead of the native @@ -121,16 +125,16 @@ (autoload 'zeroconf-init "zeroconf") (tramp-compat-funcall 'dbus-get-unique-name :system) (tramp-compat-funcall 'dbus-get-unique-name :session) - (or (tramp-compat-process-running-p "gvfs-fuse-daemon") - (tramp-compat-process-running-p "gvfsd-fuse")))) + (or (tramp-process-running-p "gvfs-fuse-daemon") + (tramp-process-running-p "gvfsd-fuse")))) "Non-nil when GVFS is available.") ;;;###tramp-autoload (defcustom tramp-gvfs-methods - '("afp" "dav" "davs" "gdrive" "nextcloud" "sftp") + '("afp" "dav" "davs" "gdrive" "media" "nextcloud" "sftp") "List of methods for remote files, accessed with GVFS." :group 'tramp - :version "27.1" + :version "28.1" :type '(repeat (choice (const "afp") (const "dav") (const "davs") @@ -138,10 +142,12 @@ (const "gdrive") (const "http") (const "https") + (const "media") (const "nextcloud") (const "sftp") (const "smb")))) +;;;###tramp-autoload (defconst tramp-goa-methods '("gdrive" "nextcloud") "List of methods which require registration at GNOME Online Accounts.") @@ -151,15 +157,23 @@ (dolist (method tramp-goa-methods) (setq tramp-gvfs-methods (delete method tramp-gvfs-methods)))) -;; Add defaults for `tramp-default-user-alist' and `tramp-default-host-alist'. ;;;###tramp-autoload -(tramp--with-startup - (when (string-match "\\(.+\\)@\\(\\(?:gmail\\|googlemail\\)\\.com\\)" - user-mail-address) - (add-to-list 'tramp-default-user-alist - `("\\`gdrive\\'" nil ,(match-string 1 user-mail-address))) - (add-to-list 'tramp-default-host-alist - '("\\`gdrive\\'" nil ,(match-string 2 user-mail-address))))) +(defvar tramp-media-methods '("afc" "gphoto2" "mtp") + "List of GVFS methods which are covered by the \"media\" method. +They are checked during start up via +`tramp-gvfs-interface-remotevolumemonitor'.") + +(defsubst tramp-gvfs-service-volumemonitor (method) + "Return the well known name of the volume monitor responsible for METHOD." + (symbol-value + (intern-soft (format "tramp-gvfs-service-%s-volumemonitor" method)))) + +;; Remove media methods if not supported. +(when tramp-gvfs-enabled + (dolist (method tramp-media-methods) + (unless (member (tramp-gvfs-service-volumemonitor method) + (dbus-list-known-names :session)) + (setq tramp-media-methods (delete method tramp-media-methods))))) ;;;###tramp-autoload (defcustom tramp-gvfs-zeroconf-domain "local" @@ -169,13 +183,15 @@ :type 'string) ;; Add the methods to `tramp-methods', in order to allow minibuffer -;; completion. +;; completion. Add defaults for `tramp-default-host-alist'. ;;;###tramp-autoload (when (featurep 'dbusbind) (tramp--with-startup - (dolist (elt tramp-gvfs-methods) - (unless (assoc elt tramp-methods) - (add-to-list 'tramp-methods (cons elt nil)))))) + (dolist (method tramp-gvfs-methods) + (unless (assoc method tramp-methods) + (add-to-list 'tramp-methods `(,method))) + (when (member method tramp-goa-methods) + (add-to-list 'tramp-default-host-alist `(,method nil "")))))) (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") "The preceding object path for own objects.") @@ -457,8 +473,209 @@ It has been changed in GVFS 1.14.") ;; </interface> ;; The basic structure for GNOME Online Accounts. We use a list :type, -;; in order to be compatible with Emacs 24 and 25. -(cl-defstruct (tramp-goa-name (:type list) :named) method user host port) +;; in order to be compatible with Emacs 25. +(cl-defstruct (tramp-goa-account (:type list) :named) method user host port) + +;;;###tramp-autoload +(defconst tramp-gvfs-service-afc-volumemonitor "org.gtk.vfs.AfcVolumeMonitor" + "The well known name of the AFC volume monitor.") + +;; This one is not needed yet. +(defconst tramp-gvfs-service-goa-volumemonitor "org.gtk.vfs.GoaVolumeMonitor" + "The well known name of the GOA volume monitor.") + +;;;###tramp-autoload +(defconst tramp-gvfs-service-gphoto2-volumemonitor + "org.gtk.vfs.GPhoto2VolumeMonitor" + "The well known name of the GPhoto2 volume monitor.") + +;;;###tramp-autoload +(defconst tramp-gvfs-service-mtp-volumemonitor "org.gtk.vfs.MTPVolumeMonitor" + "The well known name of the MTP volume monitor.") + +(defconst tramp-gvfs-path-remotevolumemonitor + "/org/gtk/Private/RemoteVolumeMonitor" + "The object path of the remote volume monitor.") + +(defconst tramp-gvfs-interface-remotevolumemonitor + "org.gtk.Private.RemoteVolumeMonitor" + "The volume monitor interface.") + +;; <interface name='org.gtk.Private.RemoteVolumeMonitor'> +;; <method name="IsSupported"> +;; <arg type='b' name='is_supported' direction='out'/> +;; </method> +;; <method name="List"> +;; <arg type='a(ssssbbbbbbbbuasa{ss}sa{sv})' name='drives' direction='out'/> +;; <arg type='a(ssssssbbssa{ss}sa{sv})' name='volumes' direction='out'/> +;; <arg type='a(ssssssbsassa{sv})' name='mounts' direction='out'/> +;; </method> +;; <method name="CancelOperation"> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='b' name='was_cancelled' direction='out'/> +;; </method> +;; <method name="MountUnmount"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='u' name='unmount_flags' direction='in'/> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; </method> +;; <method name="VolumeMount"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='u' name='mount_flags' direction='in'/> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; </method> +;; <method name="DriveEject"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='u' name='unmount_flags' direction='in'/> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; </method> +;; <method name="DrivePollForMedia"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; </method> +;; <method name="DriveStart"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='u' name='flags' direction='in'/> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; </method> +;; <method name="DriveStop"> +;; <arg type='s' name='id' direction='in'/> +;; <arg type='s' name='cancellation_id' direction='in'/> +;; <arg type='u' name='unmount_flags' direction='in'/> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; </method> +;; <method name="MountOpReply"> +;; <arg type='s' name='mount_op_id' direction='in'/> +;; <arg type='i' name='result' direction='in'/> +;; <arg type='s' name='user_name' direction='in'/> +;; <arg type='s' name='domain' direction='in'/> +;; <arg type='s' name='encoded_password' direction='in'/> +;; <arg type='i' name='password_save' direction='in'/> +;; <arg type='i' name='choice' direction='in'/> +;; <arg type='b' name='anonymous' direction='in'/> +;; </method> +;; <signal name="DriveChanged"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/> +;; </signal> +;; <signal name="DriveConnected"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/> +;; </signal> +;; <signal name="DriveDisconnected"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/> +;; </signal> +;; <signal name="DriveEjectButton"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/> +;; </signal> +;; <signal name="DriveStopButton"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssbbbbbbbbuasa{ss}sa{sv})' name='drive'/> +;; </signal> +;; <signal name="VolumeChanged"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/> +;; </signal> +;; <signal name="VolumeAdded"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/> +;; </signal> +;; <signal name="VolumeRemoved"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbbssa{ss}sa{sv})' name='volume'/> +;; </signal> +;; <signal name="MountChanged"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbsassa{sv})' name='mount'/> +;; </signal> +;; <signal name="MountAdded"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbsassa{sv})' name='mount'/> +;; </signal> +;; <signal name="MountPreUnmount"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbsassa{sv})' name='mount'/> +;; </signal> +;; <signal name="MountRemoved"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='(ssssssbsassa{sv})' name='mount'/> +;; </signal> +;; <signal name="MountOpAskPassword"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='s' name='message_to_show'/> +;; <arg type='s' name='default_user'/> +;; <arg type='s' name='default_domain'/> +;; <arg type='u' name='flags'/> +;; </signal> +;; <signal name="MountOpAskQuestion"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='s' name='message_to_show'/> +;; <arg type='as' name='choices'/> +;; </signal> +;; <signal name="MountOpShowProcesses"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='s' name='message_to_show'/> +;; <arg type='ai' name='pid'/> +;; <arg type='as' name='choices'/> +;; </signal> +;; <signal name="MountOpShowUnmountProgress"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; <arg type='s' name='message_to_show'/> +;; <arg type='x' name='time_left'/> +;; <arg type='x' name='bytes_left'/> +;; </signal> +;; <signal name="MountOpAborted"> +;; <arg type='s' name='dbus_name'/> +;; <arg type='s' name='id'/> +;; </signal> +;; </interface> + +;; STRUCT volume +;; STRING id +;; STRING name +;; STRING gicon_data +;; STRING symbolic_gicon_data +;; STRING uuid +;; STRING activation_uri +;; BOOLEAN can-mount +;; BOOLEAN should-automount +;; STRING drive-id +;; STRING mount-id +;; ARRAY identifiers +;; DICT +;; STRING key (unix-device, class, uuid, ...) +;; STRING value +;; STRING sort_key +;; ARRAY expansion +;; DICT +;; STRING key (always-call-mount, is-removable, ...) +;; VARIANT value (boolean?) + +;; The basic structure for media devices. We use a list :type, in +;; order to be compatible with Emacs 25. +(cl-defstruct (tramp-media-device (:type list) :named) method host port) ;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We ;; must use "gio <command>" tool instead. @@ -470,6 +687,7 @@ It has been changed in GVFS 1.14.") ("gvfs-monitor-file" . "monitor") ("gvfs-mount" . "mount") ("gvfs-move" . "move") + ("gvfs-rename" . "rename") ("gvfs-rm" . "remove") ("gvfs-set-attribute" . "set") ("gvfs-trash" . "trash")) @@ -625,10 +843,9 @@ First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." (unless tramp-gvfs-enabled (tramp-user-error nil "Package `tramp-gvfs' not supported")) - (let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let ((fn (assoc operation tramp-gvfs-file-name-handler-alist))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (when (featurep 'dbusbind) @@ -649,13 +866,12 @@ pass to the OPERATION." "Like `dbus-byte-array-to-string' but remove trailing \\0 if exists. Return nil for null BYTE-ARRAY." ;; The byte array could be a variant. Take care. - (let ((byte-array - (if (and (consp byte-array) (atom (car byte-array))) - byte-array (car byte-array)))) - (and byte-array - (dbus-byte-array-to-string - (if (and (consp byte-array) (zerop (car (last byte-array)))) - (butlast byte-array) byte-array))))) + (when-let ((byte-array + (if (and (consp byte-array) (atom (car byte-array))) + byte-array (car byte-array)))) + (dbus-byte-array-to-string + (if (and (consp byte-array) (zerop (car (last byte-array)))) + (butlast byte-array) byte-array)))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus MESSAGE into readable UTF8 strings, used for traces." @@ -680,6 +896,8 @@ The call will be traced by Tramp with trace level 6." (tramp-message vec 6 "%s" result(tramp-gvfs-stringify-dbus-message result)) result)) +(put #'tramp-dbus-function 'tramp-suppress-trace t) + (defmacro with-tramp-dbus-call-method (vec synchronous bus service path interface method &rest args) "Apply a D-Bus call on bus BUS. @@ -689,14 +907,13 @@ it is an asynchronous call, with `ignore' as callback function. The other arguments have the same meaning as with `dbus-call-method' or `dbus-call-method-asynchronously'." + (declare (indent 2) (debug t)) `(let ((func (if ,synchronous #'dbus-call-method #'dbus-call-method-asynchronously)) (args (append (list ,bus ,service ,path ,interface ,method) (if ,synchronous (list ,@args) (list 'ignore ,@args))))) (tramp-dbus-function ,vec func args))) -(put 'with-tramp-dbus-call-method 'lisp-indent-function 2) -(put 'with-tramp-dbus-call-method 'edebug-form-spec '(form symbolp body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-call-method\\>")) (defmacro with-tramp-dbus-get-all-properties @@ -704,6 +921,7 @@ or `dbus-call-method-asynchronously'." "Return all properties of INTERFACE. The call will be traced by Tramp with trace level 6." ;; Check, that interface exists at object path. Retrieve properties. + (declare (indent 1) (debug t)) `(when (member ,interface (tramp-dbus-function @@ -712,8 +930,6 @@ The call will be traced by Tramp with trace level 6." (tramp-dbus-function ,vec #'dbus-get-all-properties (list ,bus ,service ,path ,interface)))) -(put 'with-tramp-dbus-get-all-properties 'lisp-indent-function 1) -(put 'with-tramp-dbus-get-all-properties 'edebug-form-spec '(form symbolp body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-dbus-get-all-properties\\>")) (defvar tramp-gvfs-dbus-event-vector nil @@ -758,11 +974,15 @@ file names." (copy-directory filename newname keep-date t) (when (eq op 'rename) (delete-directory filename 'recursive))) - (let ((t1 (tramp-tramp-file-p filename)) - (t2 (tramp-tramp-file-p newname)) - (equal-remote (tramp-equal-remote filename newname)) - (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move")) - (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) + (let* ((t1 (tramp-tramp-file-p filename)) + (t2 (tramp-tramp-file-p newname)) + (equal-remote (tramp-equal-remote filename newname)) + (gvfs-operation + (cond + ((eq op 'copy) "gvfs-copy") + (equal-remote "gvfs-rename") + (t "gvfs-move"))) + (msg-operation (if (eq op 'copy) "Copying" "Renaming"))) (with-parsed-tramp-file-name (if t1 filename newname) nil (unless (file-exists-p filename) @@ -772,7 +992,7 @@ file names." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (if (or (and equal-remote @@ -833,8 +1053,8 @@ file names." (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -1301,10 +1521,11 @@ If FILE-SYSTEM is non-nil, return file system attributes." (size (cdr (assoc "filesystem::size" attr))) (used (cdr (assoc "filesystem::used" attr))) (free (cdr (assoc "filesystem::free" attr)))) - (when (and (stringp size) (stringp used) (stringp free)) - (list (string-to-number size) - (- (string-to-number size) (string-to-number used)) - (string-to-number free)))))) + (when (or size used free) + (list (string-to-number (or size "0")) + (string-to-number (or free "0")) + (- (string-to-number (or size "0")) + (string-to-number (or used "0")))))))) (defun tramp-gvfs-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -1330,8 +1551,8 @@ If FILE-SYSTEM is non-nil, return file system attributes." "Like `rename-file' for Tramp files." ;; Check if both files are local -- invoke normal rename-file. ;; Otherwise, use Tramp from local system. - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -1383,36 +1604,51 @@ If FILE-SYSTEM is non-nil, return file system attributes." ;; File name conversions. +(defun tramp-gvfs-activation-uri (filename) + "Return activation URI to be used in gio commands." + (if (tramp-tramp-file-p filename) + (with-parsed-tramp-file-name filename nil + ;; Ensure that media devices are cached. + (when (string-equal method "media") + (tramp-get-media-device v)) + (with-tramp-connection-property v "activation-uri" + (setq localname "/") + (when (string-equal "gdrive" method) + (setq method "google-drive")) + (when (string-equal "nextcloud" method) + (setq method "davs" + localname + (concat (tramp-gvfs-get-remote-prefix v) localname))) + (when (string-equal "media" method) + (when-let + ((media (tramp-get-connection-property v "media-device" nil))) + (setq method (tramp-media-device-method media) + host (tramp-media-device-host media) + port (tramp-media-device-port media)))) + (when (and user domain) + (setq user (concat domain ";" user))) + (url-recreate-url + (url-parse-make-urlobj + method (and user (url-hexify-string user)) + nil (and host (url-hexify-string host)) + (if (stringp port) (string-to-number port) port) + localname nil nil t)))) + ;; Local URI. + (url-recreate-url + (url-parse-make-urlobj "file" nil nil nil nil nil nil nil t)))) + (defun tramp-gvfs-url-file-name (filename) "Return FILENAME in URL syntax." - ;; "/" must NOT be hexified. (setq filename (tramp-compat-file-name-unquote filename)) - (let ((url-unreserved-chars (cons ?/ url-unreserved-chars)) - result) - (setq - result - (url-recreate-url - (if (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (when (string-equal "gdrive" method) - (setq method "google-drive")) - (when (string-equal "nextcloud" method) - (setq method "davs" - localname - (concat (tramp-gvfs-get-remote-prefix v) localname))) - (when (and user domain) - (setq user (concat domain ";" user))) - (url-parse-make-urlobj - method (and user (url-hexify-string user)) - nil (and host (url-hexify-string host)) - (if (stringp port) (string-to-number port) port) - (and localname (url-hexify-string localname)) nil nil t)) - (url-parse-make-urlobj - "file" nil nil nil nil - (url-hexify-string (file-truename filename)) nil nil t)))) + (let* (;; "/" must NOT be hexified. + (url-unreserved-chars (cons ?/ url-unreserved-chars)) + (result + (concat (substring (tramp-gvfs-activation-uri filename) 0 -1) + (url-hexify-string (tramp-file-local-name filename))))) (when (tramp-tramp-file-p filename) - (with-parsed-tramp-file-name filename nil - (tramp-message v 10 "remote file `%s' is URL `%s'" filename result))) + (tramp-message + (tramp-dissect-file-name filename) 10 + "remote file `%s' is URL `%s'" filename result)) result)) (defun tramp-gvfs-object-path (filename) @@ -1424,6 +1660,14 @@ If FILE-SYSTEM is non-nil, return file system attributes." (dbus-unescape-from-identifier (replace-regexp-in-string "^.*/\\([^/]+\\)$" "\\1" object-path))) +(defun tramp-gvfs-url-host (url) + "Return the host name part of URL, a string. +We cannot use `url-host', because `url-generic-parse-url' returns +a downcased host name only." + (and (stringp url) + (string-match "^[[:alnum:]]+://\\([^/:]+\\)" url) + (match-string 1 url))) + ;; D-Bus GVFS functions. @@ -1564,11 +1808,22 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) - (setq uri (url-generic-parse-url uri) + (setq host (tramp-gvfs-url-host uri) + uri (url-generic-parse-url uri) method (url-type uri) user (url-user uri) - host (url-host uri) port (url-portspec uri))) + (when (member method tramp-media-methods) + ;; Ensure that media devices are cached. + (tramp-get-media-devices nil) + (let ((v (tramp-get-connection-property + (make-tramp-media-device + :method method :host host :port port) + "vector" nil))) + (when v + (setq method (tramp-file-name-method v) + host (tramp-file-name-host v) + port (tramp-file-name-port v))))) (when (member method tramp-gvfs-methods) (with-parsed-tramp-file-name (tramp-make-tramp-file-name method user domain host port "") nil @@ -1654,11 +1909,22 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (string-equal "google-drive" method) (setq method "gdrive")) (when (and (string-equal "http" method) (stringp uri)) - (setq uri (url-generic-parse-url uri) + (setq host (tramp-gvfs-url-host uri) + uri (url-generic-parse-url uri) method (url-type uri) user (url-user uri) - host (url-host uri) port (url-portspec uri))) + (when (member method tramp-media-methods) + ;; Ensure that media devices are cached. + (tramp-get-media-devices vec) + (let ((v (tramp-get-connection-property + (make-tramp-media-device + :method method :host host :port port) + "vector" nil))) + (when v + (setq method (tramp-file-name-method v) + host (tramp-file-name-host v) + port (tramp-file-name-port v))))) (when (and (string-equal method (tramp-file-name-method vec)) (string-equal user (tramp-file-name-user vec)) @@ -1696,11 +1962,16 @@ It was \"a(say)\", but has changed to \"a{sv})\"." (defun tramp-gvfs-mount-spec (vec) "Return a mount-spec for \"org.gtk.vfs.MountTracker.mountLocation\"." - (let* ((method (tramp-file-name-method vec)) + (let* ((media (tramp-get-media-device vec)) + (method (if media + (tramp-media-device-method media) + (tramp-file-name-method vec))) (user (tramp-file-name-user vec)) (domain (tramp-file-name-domain vec)) - (host (tramp-file-name-host vec)) - (port (tramp-file-name-port vec)) + (host (if media + (tramp-media-device-host media) (tramp-file-name-host vec))) + (port (if media + (tramp-media-device-port media) (tramp-file-name-port vec))) (localname (tramp-file-name-unquote-localname vec)) (share (when (string-match "^/?\\([^/]+\\)" localname) (match-string 1 localname))) @@ -1751,6 +2022,38 @@ It was \"a(say)\", but has changed to \"a{sv})\"." ;; Return. `(:struct ,(tramp-gvfs-dbus-string-to-byte-array mount-pref) ,mount-spec))) +(defun tramp-gvfs-handler-volumeadded-volumeremoved (_dbus-name _id volume) + "Signal handler for the \"org.gtk.Private.RemoteVolumeMonitor.VolumeAdded\" \ +and \"org.gtk.Private.RemoteVolumeMonitor.VolumeRemoved\" signals." + (ignore-errors + (let* ((signal-name (dbus-event-member-name last-input-event)) + (uri (url-generic-parse-url (nth 5 volume))) + (method (url-type uri)) + (vec (make-tramp-file-name + :method "media" + ;; A host name cannot contain spaces. + :host (replace-regexp-in-string " " "_" (nth 1 volume)))) + (media (make-tramp-media-device + :method method + :host (tramp-gvfs-url-host (nth 5 volume)) + :port (and (url-portspec uri))))) + (when (member method tramp-media-methods) + (tramp-message + vec 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message volume)) + (tramp-flush-connection-properties vec) + (tramp-flush-connection-properties media) + (tramp-get-media-devices nil))))) + +(when tramp-gvfs-enabled + (dbus-register-signal + :session nil tramp-gvfs-path-remotevolumemonitor + tramp-gvfs-interface-remotevolumemonitor "VolumeAdded" + #'tramp-gvfs-handler-volumeadded-volumeremoved) + (dbus-register-signal + :session nil tramp-gvfs-path-remotevolumemonitor + tramp-gvfs-interface-remotevolumemonitor "VolumeRemoved" + #'tramp-gvfs-handler-volumeadded-volumeremoved)) + ;; Connection functions. @@ -1794,7 +2097,7 @@ This is relevant for GNOME Online Accounts." ;; Ensure that GNOME Online Accounts are cached. (when (member (tramp-file-name-method vec) tramp-goa-methods) (tramp-get-goa-accounts vec)) - (tramp-get-connection-property (tramp-make-goa-name vec) "prefix" "/"))) + (tramp-get-connection-property (tramp-get-goa-account vec) "prefix" "/"))) (defun tramp-gvfs-maybe-open-connection (vec) "Maybe open a connection VEC. @@ -1843,7 +2146,7 @@ connection if a previous connection has died for some reason." ;; Ensure that GNOME Online Accounts are cached. (tramp-get-goa-accounts vec) (when (tramp-get-connection-property - (tramp-make-goa-name vec) "FilesDisabled" t) + (tramp-get-goa-account vec) "FilesDisabled" t) (tramp-user-error vec "There is no Online Account `%s'" (tramp-make-tramp-file-name vec 'noloc)))) @@ -1968,12 +2271,12 @@ is applied, and it returns t if the return code is zero." (and (tramp-flush-file-properties vec "/") nil))))) -;; D-Bus GNOME Online Accounts functions. +;; GNOME Online Accounts functions. -(defun tramp-make-goa-name (vec) - "Transform VEC into a `tramp-goa-name' structure." +(defun tramp-get-goa-account (vec) + "Transform VEC into a `tramp-goa-account' structure." (when (tramp-file-name-p vec) - (make-tramp-goa-name + (make-tramp-goa-account :method (tramp-file-name-method vec) :user (tramp-file-name-user vec) :host (tramp-file-name-host vec) @@ -1981,12 +2284,12 @@ is applied, and it returns t if the return code is zero." (defun tramp-get-goa-accounts (vec) "Retrieve GNOME Online Accounts, and cache them. -The hash key is a `tramp-goa-name' structure. The value is an +The hash key is a `tramp-goa-account' structure. The value is an alist of the properties of `tramp-goa-interface-account' and -`tramp-goa-interface-files' of the corresponding GNOME online -account. Additionally, a property \"prefix\" is added. +`tramp-goa-interface-files' of the corresponding GNOME Online +Account. Additionally, a property \"prefix\" is added. VEC is used only for traces." - (with-tramp-connection-property (tramp-make-goa-name vec) "goa-accounts" + (with-tramp-connection-property nil "goa-accounts" (dolist (object-path (mapcar @@ -2012,15 +2315,15 @@ VEC is used only for traces." (cdr (assoc "ProviderType" account-properties)) '("google" "owncloud")) (string-match tramp-goa-identity-regexp identity)) - (setq key (make-tramp-goa-name + (setq key (make-tramp-goa-account :method (cdr (assoc "ProviderType" account-properties)) :user (match-string 1 identity) :host (match-string 2 identity) :port (match-string 3 identity))) - (when (string-equal (tramp-goa-name-method key) "google") - (setf (tramp-goa-name-method key) "gdrive")) - (when (string-equal (tramp-goa-name-method key) "owncloud") - (setf (tramp-goa-name-method key) "nextcloud")) + (when (string-equal (tramp-goa-account-method key) "google") + (setf (tramp-goa-account-method key) "gdrive")) + (when (string-equal (tramp-goa-account-method key) "owncloud") + (setf (tramp-goa-account-method key) "nextcloud")) ;; Cache all properties. (dolist (prop (nconc account-properties files-properties)) (tramp-set-connection-property key (car prop) (cdr prop))) @@ -2036,6 +2339,80 @@ VEC is used only for traces." ;; Mark, that goa accounts have been cached. "cached")) +(defun tramp-parse-goa-accounts (service) + "Return a list of (user host) tuples allowed to access. +It checks for registered GNOME Online Accounts." + ;; SERVICE might be encoded as a DNS-SD service. + (and (string-match tramp-dns-sd-service-regexp service) + (setq service (match-string 1 service))) + (mapcar + (lambda (key) + (and (tramp-goa-account-p key) + (string-equal service (tramp-goa-account-method key)) + (list (tramp-goa-account-user key) + (tramp-goa-account-host key)))) + (hash-table-keys tramp-cache-data))) + + +;; Media devices functions. + +(defun tramp-get-media-device (vec) + "Transform VEC into a `tramp-media-device' structure. +Check, that respective cache values do exist." + (if-let ((media (tramp-get-connection-property vec "media-device" nil)) + (prop (tramp-get-connection-property media "vector" nil))) + media + (tramp-get-media-devices vec) + (tramp-get-connection-property vec "media-device" nil))) + +(defun tramp-get-media-devices (vec) + "Retrieve media devices, and cache them. +The hash key is a `tramp-media-device' structure. +VEC is used only for traces." + (let (devices) + (dolist (method tramp-media-methods) + (dolist (volume (cadr (with-tramp-dbus-call-method vec t + :session (tramp-gvfs-service-volumemonitor method) + tramp-gvfs-path-remotevolumemonitor + tramp-gvfs-interface-remotevolumemonitor "List"))) + (let* ((uri (url-generic-parse-url (nth 5 volume))) + (vec (make-tramp-file-name + :method "media" + ;; A host name cannot contain spaces. + :host (replace-regexp-in-string " " "_" (nth 1 volume)))) + (media (make-tramp-media-device + :method method + :host (tramp-gvfs-url-host (nth 5 volume)) + :port (and (url-portspec uri) + (number-to-string (url-portspec uri)))))) + (push (tramp-file-name-host vec) devices) + (tramp-set-connection-property vec "activation-uri" (nth 5 volume)) + (tramp-set-connection-property vec "media-device" media) + (tramp-set-connection-property media "vector" vec)))) + + ;; Adapt default host name, supporting /media:: when possible. + (setq tramp-default-host-alist + (append + `(("media" nil ,(if (= (length devices) 1) (car devices) ""))) + (delete + (assoc "media" tramp-default-host-alist) + tramp-default-host-alist))))) + +(defun tramp-parse-media-names (service) + "Return a list of (user host) tuples allowed to access. +It checks for mounted media devices." + ;; SERVICE might be encoded as a DNS-SD service. + (and (string-match tramp-dns-sd-service-regexp service) + (setq service (match-string 1 service))) + (mapcar + (lambda (key) + (and (tramp-media-device-p key) + (string-equal service (tramp-media-device-method key)) + (tramp-get-connection-property key "vector" nil) + (list nil (tramp-file-name-host + (tramp-get-connection-property key "vector" nil))))) + (hash-table-keys tramp-cache-data))) + ;; D-Bus zeroconf functions. @@ -2080,39 +2457,62 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." (list user host))) result)))) -;; Add completion functions for AFP, DAV, DAVS, SFTP and SMB methods. (when tramp-gvfs-enabled - ;; Suppress D-Bus error messages. - (let (tramp-gvfs-dbus-event-vector) + ;; Suppress D-Bus error messages and Tramp traces. + (let ((tramp-verbose 0) + tramp-gvfs-dbus-event-vector fun) + ;; Add completion functions for services announced by DNS-SD. + ;; See <http://www.dns-sd.org/ServiceTypes.html> for valid service types. (zeroconf-init tramp-gvfs-zeroconf-domain) - (if (zeroconf-list-service-types) - (progn - (tramp-set-completion-function - "afp" '((tramp-zeroconf-parse-device-names "_afpovertcp._tcp"))) - (tramp-set-completion-function - "dav" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "davs" '((tramp-zeroconf-parse-device-names "_webdav._tcp"))) - (tramp-set-completion-function - "sftp" '((tramp-zeroconf-parse-device-names "_ssh._tcp") - (tramp-zeroconf-parse-device-names "_workstation._tcp"))) - (when (member "smb" tramp-gvfs-methods) - (tramp-set-completion-function - "smb" '((tramp-zeroconf-parse-device-names "_smb._tcp"))))) - - (when (executable-find "avahi-browse") + (when (setq fun (or (and (zeroconf-list-service-types) + #'tramp-zeroconf-parse-device-names) + (and (executable-find "avahi-browse") + #'tramp-gvfs-parse-device-names))) + (when (member "afp" tramp-gvfs-methods) + (tramp-set-completion-function + "afp" `((,fun "_afpovertcp._tcp")))) + (when (member "dav" tramp-gvfs-methods) + (tramp-set-completion-function + "dav" `((,fun "_webdav._tcp") + (,fun "_webdavs._tcp")))) + (when (member "davs" tramp-gvfs-methods) + (tramp-set-completion-function + "davs" `((,fun "_webdav._tcp") + (,fun "_webdavs._tcp")))) + (when (member "ftp" tramp-gvfs-methods) + (tramp-set-completion-function + "ftp" `((,fun "_ftp._tcp")))) + (when (member "http" tramp-gvfs-methods) (tramp-set-completion-function - "afp" '((tramp-gvfs-parse-device-names "_afpovertcp._tcp"))) + "http" `((,fun "_http._tcp") + (,fun "_https._tcp")))) + (when (member "https" tramp-gvfs-methods) (tramp-set-completion-function - "dav" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) + "https" `((,fun "_http._tcp") + (,fun "_https._tcp")))) + (when (member "sftp" tramp-gvfs-methods) (tramp-set-completion-function - "davs" '((tramp-gvfs-parse-device-names "_webdav._tcp"))) + "sftp" `((,fun "_sftp-ssh._tcp") + (,fun "_ssh._tcp") + (,fun "_workstation._tcp")))) + (when (member "smb" tramp-gvfs-methods) (tramp-set-completion-function - "sftp" '((tramp-gvfs-parse-device-names "_ssh._tcp") - (tramp-gvfs-parse-device-names "_workstation._tcp"))) - (when (member "smb" tramp-gvfs-methods) - (tramp-set-completion-function - "smb" '((tramp-gvfs-parse-device-names "_smb._tcp")))))))) + "smb" `((,fun "_smb._tcp"))))) + + ;; Add completion functions for GNOME Online Accounts. + (tramp-get-goa-accounts nil) + (dolist (method tramp-goa-methods) + (when (member method tramp-gvfs-methods) + (tramp-set-completion-function + method `((tramp-parse-goa-accounts ,(format "_%s._tcp" method)))))) + + ;; Add completion functions for media devices. + (tramp-get-media-devices nil) + (tramp-set-completion-function + "media" + (mapcar + (lambda (method) `(tramp-parse-media-names ,(format "_%s._tcp" method))) + tramp-media-methods)))) (add-hook 'tramp-unload-hook (lambda () @@ -2125,7 +2525,7 @@ This uses \"avahi-browse\" in case D-Bus is not enabled in Avahi." ;; * (Customizable) unmount when exiting Emacs. See tramp-archive.el. ;; ;; * Host name completion for existing mount points (afp-server, -;; smb-server, google-drive, nextcloud) or via smb-network or network. +;; smb-server) or via smb-network or network. ;; ;; * Check, how two shares of the same SMB server can be mounted in ;; parallel. diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 9f539850139..445098a5bca 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -157,10 +157,9 @@ Operations not mentioned here will be handled by the default Emacs primitives.") "Invoke the rclone handler for OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (tramp--with-startup @@ -220,7 +219,7 @@ file names." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (if (or (and t1 (not (tramp-rclone-file-name-p filename))) @@ -271,8 +270,8 @@ file names." (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -429,8 +428,8 @@ file names." (defun tramp-rclone-handle-rename-file (filename newname &optional ok-if-already-exists) "Like `rename-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -564,7 +563,7 @@ connection if a previous connection has died for some reason." ,(tramp-rclone-mount-point vec) ;; This could be nil. ,(tramp-get-method-parameter vec 'tramp-mount-args)))) - (while (not (file-exists-p (tramp-make-tramp-file-name vec 'localname))) + (while (not (file-exists-p (tramp-make-tramp-file-name vec 'noloc))) (tramp-cleanup-connection vec 'keep-debug 'keep-password)) ;; Mark it as connected. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index af97328b3d3..5a3abc31ea6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -491,8 +491,8 @@ The string is used in `tramp-methods'.") For every remote host, this variable will be set buffer local, keeping the list of existing directories on that host. -You can use `~' in this list, but when searching for a shell which groks -tilde expansion, all directory names starting with `~' will be ignored. +You can use \"~\" in this list, but when searching for a shell which groks +tilde expansion, all directory names starting with \"~\" will be ignored. `Default Directories' represent the list of directories given by the command \"getconf PATH\". It is recommended to use this @@ -537,12 +537,13 @@ based on the Tramp and Emacs versions, and should not be set here." ;;;###tramp-autoload (defcustom tramp-sh-extra-args - '(("/bash\\'" . "-norc -noprofile") + '(("/bash\\'" . "-noediting -norc -noprofile") ("/zsh\\'" . "-f +Z -V")) "Alist specifying extra arguments to pass to the remote shell. Entries are (REGEXP . ARGS) where REGEXP is a regular expression matching the shell file name and ARGS is a string specifying the -arguments. +arguments. These arguments shall disable line editing, see +`tramp-open-shell'. This variable is only used when Tramp needs to start up another shell for tilde expansion. The extra arguments should typically prevent the @@ -866,8 +867,12 @@ Escape sequence %s is replaced with name of Perl binary.") "Perl program to use for decoding a file. Escape sequence %s is replaced with name of Perl binary.") +(defconst tramp-hexdump-encode "%h -v -e '16/1 \" %%02x\" \"\\n\"'" + "`hexdump' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + (defconst tramp-awk-encode - "od -v -t x1 -A n | busybox awk '\\ + "%a '\\ BEGIN { b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\" b16 = \"0123456789abcdef\" @@ -897,11 +902,25 @@ END { } printf tail }'" - "Awk program to use for encoding a file. + "`awk' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-hexdump-awk-encode + (format "%s | %s" tramp-hexdump-encode tramp-awk-encode) + "`hexdump' / `awk' pipe to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-od-encode "%o -v -t x1 -A n" + "`od' program to use for encoding a file. +This string is passed to `format', so percent characters need to be doubled.") + +(defconst tramp-od-awk-encode + (format "%s | %s" tramp-od-encode tramp-awk-encode) + "`od' / `awk' pipe to use for encoding a file. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-awk-decode - "busybox awk '\\ + "%a '\\ BEGIN { b64 = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\" } @@ -926,12 +945,6 @@ BEGIN { "Awk program to use for decoding a file. This string is passed to `format', so percent characters need to be doubled.") -(defconst tramp-awk-coding-test - "test -c /dev/zero && \ -od -v -t x1 -A n </dev/null && \ -busybox awk '{}' </dev/null" - "Test command for checking `tramp-awk-encode' and `tramp-awk-decode'.") - (defconst tramp-vc-registered-read-file-names "echo \"(\" while read file; do @@ -1051,9 +1064,7 @@ component is used as the target of the symlink." (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name target)))))) + (setq target (tramp-file-local-name (expand-file-name target))))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -1104,8 +1115,7 @@ component is used as the target of the symlink." "Like `file-truename' for Tramp files." ;; Preserve trailing "/". (funcall - (if (tramp-compat-directory-name-p filename) - #'file-name-as-directory #'identity) + (if (directory-name-p filename) #'file-name-as-directory #'identity) ;; Quote properly. (funcall (if (tramp-compat-file-name-quoted-p filename) @@ -1190,9 +1200,9 @@ component is used as the target of the symlink." (tramp-error v 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit)) - (setq result (reverse result)) - ;; Combine list to form string. - (setq result + (setq result (reverse result) + ;; Combine list to form string. + result (if result (string-join (cons "" result) "/") "/")) (when (string-empty-p result) (setq result "/"))))) @@ -1263,8 +1273,8 @@ component is used as the target of the symlink." (defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) "Implement `file-attributes' for Tramp files using the ls(1) command." (let (symlinkp dirp - res-inode res-filemodes res-numlinks - res-uid res-gid res-size res-symlink-target) + res-inode res-filemodes res-numlinks + res-uid res-gid res-size res-symlink-target) (tramp-message vec 5 "file attributes with ls: %s" localname) ;; We cannot send all three commands combined, it could exceed ;; NAME_MAX or PATH_MAX. Happened on macOS, for example. @@ -1948,7 +1958,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 (tramp-compat-directory-name-p newname))) + (not (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))) @@ -1978,8 +1988,8 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" "Like `rename-file' for Tramp files." ;; Check if both files are local -- invoke normal rename-file. ;; Otherwise, use Tramp from local system. - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -2030,7 +2040,7 @@ file names." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter @@ -2171,8 +2181,8 @@ the uid and gid from FILENAME." v 'file-error "Unknown operation `%s', must be `copy' or `rename'" op)))) - (localname1 (tramp-compat-file-local-name filename)) - (localname2 (tramp-compat-file-local-name newname)) + (localname1 (tramp-file-local-name filename)) + (localname2 (tramp-file-local-name newname)) (prefix (file-remote-p (if t1 filename newname))) cmd-result) (when (and (eq op 'copy) (file-directory-p filename)) @@ -2714,7 +2724,7 @@ The method used must be an out-of-band method." (when (file-symlink-p filename) (goto-char (search-backward "->" beg 'noerror))) (search-backward - (if (tramp-compat-directory-name-p filename) + (if (directory-name-p filename) "." (file-name-nondirectory filename)) beg 'noerror) @@ -2724,12 +2734,11 @@ The method used must be an out-of-band method." (goto-char (point-min)) ;; First find the line to put it on. (when (re-search-forward "^\\([[:space:]]*total\\)" nil t) - (let ((available (get-free-disk-space "."))) - (when available - ;; Replace "total" with "total used", to avoid confusion. - (replace-match "\\1 used in directory") - (end-of-line) - (insert " available " available)))) + (when-let ((available (get-free-disk-space "."))) + ;; Replace "total" with "total used", to avoid confusion. + (replace-match "\\1 used in directory") + (end-of-line) + (insert " available " available))) (goto-char (point-max))))))) @@ -2796,8 +2805,11 @@ the result will be a local, non-Tramp, file name." ;; We use BUFFER also as connection buffer during setup. Because of ;; this, its original contents must be saved, and restored once ;; connection has been setup. +;; The complete STDERR buffer is available only when the process has +;; terminated. (defun tramp-sh-handle-make-process (&rest args) - "Like `make-process' for Tramp files." + "Like `make-process' for Tramp files. +STDERR can also be a file name." (when args (with-parsed-tramp-file-name (expand-file-name default-directory) nil (let ((name (plist-get args :name)) @@ -2829,14 +2841,23 @@ the result will be a local, non-Tramp, file name." (signal 'wrong-type-argument (list #'functionp sentinel))) (unless (or (null stderr) (bufferp stderr) (stringp stderr)) (signal 'wrong-type-argument (list #'stringp stderr))) + (when (and (stringp stderr) (tramp-tramp-file-p stderr) + (not (tramp-equal-remote default-directory stderr))) + (signal 'file-error (list "Wrong stderr" stderr))) (let* ((buffer (if buffer (get-buffer-create buffer) ;; BUFFER can be nil. We use a temporary buffer. (generate-new-buffer tramp-temp-buffer-name))) - (stderr (and stderr (get-buffer-create stderr))) - (tmpstderr (and stderr (tramp-make-tramp-temp-file v))) + ;; STDERR can also be a file name. + (tmpstderr + (and stderr + (if (and (stringp stderr) (tramp-tramp-file-p stderr)) + (tramp-unquote-file-local-name stderr) + (tramp-make-tramp-temp-file v)))) + (remote-tmpstderr + (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) (program (car command)) (args (cdr command)) ;; When PROGRAM matches "*sh", and the first arg is @@ -2965,21 +2986,35 @@ the result will be a local, non-Tramp, file name." (ignore-errors (set-process-query-on-exit-flag p (null noquery)) (set-marker (process-mark p) (point))) + ;; We must flush them here already; otherwise + ;; `rename-file', `delete-file' or + ;; `insert-file-contents' will fail. + (tramp-flush-connection-property v "process-name") + (tramp-flush-connection-property v "process-buffer") + ;; Copy tmpstderr file. + (when (and (stringp stderr) + (not (tramp-tramp-file-p stderr))) + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (rename-file remote-tmpstderr stderr)))) ;; Provide error buffer. This shows only ;; initial error messages; messages arriving - ;; later on shall be inserted by `auto-revert'. - ;; The temporary file will still be existing. - ;; TODO: Write a sentinel, which deletes the - ;; temporary file. - (when tmpstderr - ;; We must flush them here already; otherwise - ;; `insert-file-contents' will fail. - (tramp-flush-connection-property v "process-name") - (tramp-flush-connection-property v "process-buffer") + ;; later on will be inserted when the process is + ;; deleted. The temporary file will exist until + ;; the process is deleted. + (when (bufferp stderr) (with-current-buffer stderr - (insert-file-contents - (tramp-make-tramp-file-name v tmpstderr) 'visit) - (auto-revert-mode))) + (insert-file-contents-literally + remote-tmpstderr 'visit)) + ;; Delete tmpstderr file. + (add-function + :after (process-sentinel p) + (lambda (_proc _msg) + (with-current-buffer stderr + (insert-file-contents-literally + remote-tmpstderr 'visit nil nil 'replace)) + (delete-file remote-tmpstderr)))) ;; Return process. p))) @@ -3028,7 +3063,7 @@ the result will be a local, non-Tramp, file name." (setq infile (expand-file-name infile)) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) + (setq input (tramp-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input 'nohop)) @@ -3059,8 +3094,7 @@ the result will be a local, non-Tramp, file name." (setcar (cdr destination) (expand-file-name (cadr destination))) (if (tramp-equal-remote default-directory (cadr destination)) ;; stderr is on the same remote host. - (setq stderr (with-parsed-tramp-file-name - (cadr destination) nil localname)) + (setq stderr (tramp-file-local-name (cadr destination))) ;; stderr must be copied to remote host. The temporary ;; file must be deleted after execution. (setq stderr (tramp-make-tramp-temp-file v) @@ -3122,7 +3156,7 @@ the result will be a local, non-Tramp, file name." (append (tramp-get-remote-path (tramp-dissect-file-name default-directory)) ;; The equivalent to `exec-directory'. - `(,(tramp-compat-file-local-name default-directory)))) + `(,(tramp-file-local-name (expand-file-name default-directory))))) (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." @@ -3468,8 +3502,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-handle-vc-registered (file) "Like `vc-registered' for Tramp files." (when vc-handled-backends - (let ((tramp-message-show-message - (and (not revert-buffer-in-progress-p) tramp-message-show-message)) + (let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message)) (temp-message (unless revert-buffer-in-progress-p ""))) (with-temp-message temp-message (with-parsed-tramp-file-name file nil @@ -3559,10 +3592,9 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-file-name-handler (operation &rest args) "Invoke remote-shell Tramp file name handler. Fall back to normal file name handler if no Tramp handler exists." - (let ((fn (assoc operation tramp-sh-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let ((fn (assoc operation tramp-sh-file-name-handler-alist))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;; This must be the last entry, because `identity' always matches. ;;;###tramp-autoload @@ -3921,7 +3953,7 @@ hosts, or files, disagree." First arg VEC specifies the connection, PROGNAME is the program to search for, and DIRLIST gives the list of directories to search. If IGNORE-TILDE is non-nil, directory names starting -with `~' will be ignored. If IGNORE-PATH is non-nil, searches +with \"~\" will be ignored. If IGNORE-PATH is non-nil, searches only in DIRLIST. Returns the absolute file name of PROGNAME, if found, and nil otherwise. @@ -3947,8 +3979,8 @@ This function expects to be in the right *tramp* buffer." ;; Remove all ~/foo directories from dirlist. (let (newdl d) (while dirlist - (setq d (car dirlist)) - (setq dirlist (cdr dirlist)) + (setq d (car dirlist) + dirlist (cdr dirlist)) (unless (char-equal ?~ (aref d 0)) (setq newdl (cons d newdl)))) (setq dirlist (nreverse newdl)))) @@ -3995,8 +4027,7 @@ variable PATH." (setq tmpfile (tramp-make-tramp-file-name vec (tramp-make-tramp-temp-file vec))) (write-region command nil tmpfile) - (tramp-send-command - vec (format ". %s" (tramp-compat-file-local-name tmpfile))) + (tramp-send-command vec (format ". %s" (tramp-file-local-name tmpfile))) (delete-file tmpfile)))) ;; ------------------------------------------------------------ @@ -4072,7 +4103,28 @@ file exists and nonzero exit status otherwise." (with-tramp-progress-reporter vec 5 (format-message "Opening remote shell `%s'" shell) ;; Find arguments for this shell. - (let ((extra-args (tramp-get-sh-extra-args shell))) + (let ((extra-args (tramp-get-sh-extra-args shell)) + (p (tramp-get-connection-process vec))) + ;; The readline library can disturb Tramp. For example, the + ;; very recent version of libedit, the *BSD implementation of + ;; readline, confuses Tramp. So we disable line editing. Since + ;; $EDITRC is not supported on all target systems, we must move + ;; ~/.editrc temporarily somewhere else. For bash and zsh we + ;; have disabled this already during shell invocation, see + ;; `tramp-sh-extra-args' (Bug#39399). + ;; The shell prompt might not be set yet, so we must read any + ;; prompt via `tramp-barf-if-no-shell-prompt'. + (unless extra-args + (tramp-send-command vec "rm -f ~/.editrc.tramp" t t) + (tramp-barf-if-no-shell-prompt p 10 "Couldn't find remote shell prompt") + (tramp-send-command + vec "test -e ~/.editrc && mv -f ~/.editrc ~/.editrc.tramp" t t) + (tramp-barf-if-no-shell-prompt p 10 "Couldn't find remote shell prompt") + (tramp-send-command vec "echo 'edit off' >~/.editrc" t t) + (tramp-barf-if-no-shell-prompt + p 10 "Couldn't find remote shell prompt")) + ;; It is useful to set the prompt in the following command + ;; because some people have a setting for $PS1 which /bin/sh ;; doesn't know about and thus /bin/sh will display a strange ;; prompt. For example, if $PS1 has "${CWD}" in the value, then ;; ksh will display the current working directory but /bin/sh @@ -4106,6 +4158,11 @@ file exists and nonzero exit status otherwise." (tramp-shell-quote-argument tramp-end-of-output) shell (or extra-args "")) t) + ;; Reset ~/.editrc. + (unless extra-args + (tramp-send-command vec "rm -f ~/.editrc" t) + (tramp-send-command + vec "test -e ~/.editrc.tramp && mv -f ~/.editrc.tramp ~/.editrc" t)) ;; Check proper HISTFILE setting. We give up when not working. (when (and (stringp tramp-histfile-override) (file-name-directory tramp-histfile-override)) @@ -4383,7 +4440,7 @@ and end of region, and are expected to replace the region contents with the encoded or decoded results, respectively.") (defconst tramp-remote-coding-commands - `((b64 "base64" "base64 -d -i") + '((b64 "base64" "base64 -d -i") ;; "-i" is more robust with older base64 from GNU coreutils. ;; However, I don't know whether all base64 versions do supports ;; this option. @@ -4394,8 +4451,9 @@ with the encoded or decoded results, respectively.") (b64 "recode data..base64" "recode base64..data") (b64 tramp-perl-encode-with-module tramp-perl-decode-with-module) (b64 tramp-perl-encode tramp-perl-decode) - ;; This is painful slow, so we put it on the end. - (b64 tramp-awk-encode tramp-awk-decode ,tramp-awk-coding-test) + ;; These are painfully slow, so we put them on the end. + (b64 tramp-hexdump-awk-encode tramp-awk-decode) + (b64 tramp-od-awk-encode tramp-awk-decode) (uu "uuencode xxx" "uudecode -o /dev/stdout" "test -c /dev/stdout") (uu "uuencode xxx" "uudecode -o -") (uu "uuencode xxx" "uudecode -p") @@ -4421,6 +4479,8 @@ Perl or Shell implementation for this functionality. This program will be transferred to the remote host, and it is available as shell function with the same name. A \"%t\" format specifier in the variable value denotes a temporary file. +\"%a\", \"%h\" and \"%o\" format specifiers are replaced by the +respective `awk', `hexdump' and `od' commands. The optional TEST command can be used for further tests, whether ENCODING and DECODING are applicable.") @@ -4439,8 +4499,8 @@ Goes through the list `tramp-local-coding-commands' and (catch 'wont-work-local (let ((format (nth 0 litem)) (remote-commands tramp-remote-coding-commands)) - (setq loc-enc (nth 1 litem)) - (setq loc-dec (nth 2 litem)) + (setq loc-enc (nth 1 litem) + loc-dec (nth 2 litem)) ;; If the local encoder or decoder is a string, the ;; corresponding command has to work locally. (if (not (stringp loc-enc)) @@ -4462,20 +4522,15 @@ Goes through the list `tramp-local-coding-commands' and (setq ritem (pop remote-commands)) (catch 'wont-work-remote (when (equal format (nth 0 ritem)) - (setq rem-enc (nth 1 ritem)) - (setq rem-dec (nth 2 ritem)) - (setq rem-test (nth 3 ritem)) + (setq rem-enc (nth 1 ritem) + rem-dec (nth 2 ritem) + rem-test (nth 3 ritem)) ;; Check the remote test command if exists. (when (stringp rem-test) (tramp-message vec 5 "Checking remote test command `%s'" rem-test) (unless (tramp-send-command-and-check vec rem-test t) (throw 'wont-work-remote nil))) - ;; Check if remote perl exists when necessary. - (when (and (symbolp rem-enc) - (string-match-p "perl" (symbol-name rem-enc)) - (not (tramp-get-remote-perl vec))) - (throw 'wont-work-remote nil)) ;; Check if remote encoding and decoding commands can be ;; called remotely with null input and output. This makes ;; sure there are no syntax errors and the command is really @@ -4485,10 +4540,36 @@ Goes through the list `tramp-local-coding-commands' and ;; redirecting "mimencode" output to /dev/null, then as root ;; it might change the permissions of /dev/null! (unless (stringp rem-enc) - (let ((name (symbol-name rem-enc))) + (let ((name (symbol-name rem-enc)) + (value (symbol-value rem-enc))) + ;; Check if remote perl exists when necessary. + (and (string-match-p "perl" name) + (not (tramp-get-remote-perl vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote awk exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%a" value) + (not (tramp-get-remote-awk vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote hexdump exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%h" value) + (not (tramp-get-remote-hexdump vec)) + (throw 'wont-work-remote nil)) + ;; Check if remote od exists when necessary. + (and (string-match-p "\\(^\\|[^%]\\)%o" value) + (not (tramp-get-remote-od vec)) + (throw 'wont-work-remote nil)) (while (string-match "-" name) (setq name (replace-match "_" nil t name))) - (tramp-maybe-send-script vec (symbol-value rem-enc) name) + (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value) + (setq value + (format-spec + value + (format-spec-make + ?a (tramp-get-remote-awk vec) + ?h (tramp-get-remote-hexdump vec) + ?o (tramp-get-remote-od vec))) + value (replace-regexp-in-string "%" "%%" value))) + (tramp-maybe-send-script vec value name) (setq rem-enc name))) (tramp-message vec 5 @@ -4503,6 +4584,15 @@ Goes through the list `tramp-local-coding-commands' and tmpfile) (while (string-match "-" name) (setq name (replace-match "_" nil t name))) + (when (string-match-p "\\(^\\|[^%]\\)%[aho]" value) + (setq value + (format-spec + value + (format-spec-make + ?a (tramp-get-remote-awk vec) + ?h (tramp-get-remote-hexdump vec) + ?o (tramp-get-remote-od vec))) + value (replace-regexp-in-string "%" "%%" value))) (when (string-match-p "\\(^\\|[^%]\\)%t" value) (setq tmpfile (make-temp-name @@ -4513,7 +4603,7 @@ Goes through the list `tramp-local-coding-commands' and (format-spec value (format-spec-make - ?t (tramp-compat-file-local-name tmpfile))))) + ?t (tramp-file-local-name tmpfile))))) (tramp-maybe-send-script vec value name) (setq rem-dec name))) (tramp-message @@ -4531,9 +4621,9 @@ Goes through the list `tramp-local-coding-commands' and (throw 'wont-work-remote nil))) ;; `rem-enc' and `rem-dec' could be a string meanwhile. - (setq rem-enc (nth 1 ritem)) - (setq rem-dec (nth 2 ritem)) - (setq found t))))))) + (setq rem-enc (nth 1 ritem) + rem-dec (nth 2 ritem) + found t))))))) (when found ;; Set connection properties. Since the commands are risky @@ -4796,7 +4886,7 @@ If there is just some editing, retry it after 5 seconds." vec 5 "Cannot timeout session, trying it again in %s seconds." 5) (run-at-time 5 nil 'tramp-timeout-session vec)) (tramp-message - vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'localname)) + vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc)) (tramp-cleanup-connection vec 'keep-debug))) (defun tramp-maybe-open-connection (vec) @@ -4818,11 +4908,8 @@ connection if a previous connection has died for some reason." (not (tramp-file-name-equal-p vec (car tramp-current-connection))) (time-less-p - ;; `current-time' can be removed once we get rid of Emacs 24. - (time-since (or (cdr tramp-current-connection) (current-time))) - ;; `seconds-to-time' can be removed once we get rid - ;; of Emacs 24. - (seconds-to-time (or tramp-connection-min-time-diff 0)))) + (time-since (cdr tramp-current-connection)) + (or tramp-connection-min-time-diff 0))) (throw 'suppress 'suppress)) ;; If too much time has passed since last command was sent, look @@ -4833,11 +4920,9 @@ connection if a previous connection has died for some reason." ;; try to send a command from time to time, then look again ;; whether the process is really alive. (condition-case nil - ;; `seconds-to-time' can be removed once we get rid of Emacs 24. - (when (and (time-less-p (seconds-to-time 60) - (time-since - (tramp-get-connection-property - p "last-cmd-time" (seconds-to-time 0)))) + (when (and (time-less-p + 60 (time-since + (tramp-get-connection-property p "last-cmd-time" 0))) (process-live-p p)) (tramp-send-command vec "echo are you awake" t t) (unless (and (process-live-p p) @@ -5594,7 +5679,7 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil." "%s -t %s %s" result (format-time-string "%Y%m%d%H%M.%S") - (tramp-compat-file-local-name tmpfile)))) + (tramp-file-local-name tmpfile)))) (delete-file tmpfile)) result))) @@ -5769,6 +5854,47 @@ ID-FORMAT valid values are `string' and `integer'." tramp-unknown-id-string) (t res))))) +(defun tramp-get-remote-busybox (vec) + "Determine remote `busybox' command." + (with-tramp-connection-property vec "busybox" + (tramp-message vec 5 "Finding a suitable `busybox' command") + (tramp-find-executable vec "busybox" (tramp-get-remote-path vec)))) + +(defun tramp-get-remote-awk (vec) + "Determine remote `awk' command." + (with-tramp-connection-property vec "awk" + (tramp-message vec 5 "Finding a suitable `awk' command") + (or (tramp-find-executable vec "awk" (tramp-get-remote-path vec)) + (let* ((busybox (tramp-get-remote-busybox vec)) + (command (format "%s %s" busybox "awk"))) + (and busybox + (tramp-send-command-and-check + vec (concat command " {} </dev/null")) + command))))) + +(defun tramp-get-remote-hexdump (vec) + "Determine remote `hexdump' command." + (with-tramp-connection-property vec "hexdump" + (tramp-message vec 5 "Finding a suitable `hexdump' command") + (or (tramp-find-executable vec "hexdump" (tramp-get-remote-path vec)) + (let* ((busybox (tramp-get-remote-busybox vec)) + (command (format "%s %s" busybox "hexdump"))) + (and busybox + (tramp-send-command-and-check vec (concat command " </dev/null")) + command))))) + +(defun tramp-get-remote-od (vec) + "Determine remote `od' command." + (with-tramp-connection-property vec "od" + (tramp-message vec 5 "Finding a suitable `od' command") + (or (tramp-find-executable vec "od" (tramp-get-remote-path vec)) + (let* ((busybox (tramp-get-remote-busybox vec)) + (command (format "%s %s" busybox "od"))) + (and busybox + (tramp-send-command-and-check + vec (concat command " -A n </dev/null")) + command))))) + (defun tramp-get-env-with-u-option (vec) "Check, whether the remote `env' command supports the -u option." (with-tramp-connection-property vec "env-u-option" @@ -5889,9 +6015,6 @@ function cell is returned to be applied on a buffer." ;; likely to produce long command lines, and some shells choke on ;; long command lines. ;; -;; * Don't search for perl5 and perl. Instead, only search for perl and -;; then look if it's the right version (with `perl -v'). -;; ;; * When editing a remote CVS controlled file as a different user, VC ;; gets confused about the file locking status. Try to find out why ;; the workaround doesn't work. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index bf77ab9dee8..f02be394a7b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -329,10 +329,9 @@ This can be used to disable echo etc." "Invoke the SMB related OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (let ((fn (assoc operation tramp-smb-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (unless (memq system-type '(cygwin windows-nt)) @@ -420,7 +419,7 @@ pass to the OPERATION." v tramp-file-missing "Copying directory" "No such file or directory" dirname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-already-exists newname)) (cond ;; We must use a local temporary directory. @@ -581,40 +580,39 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." tramp-file-missing "Copying file" "No such file or directory" filename)) - (let ((tmpfile (file-local-copy filename))) - (if tmpfile - ;; Remote filename. - (condition-case err - (rename-file tmpfile newname ok-if-already-exists) - ((error quit) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Remote newname. + (if-let ((tmpfile (file-local-copy filename))) + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (and (file-directory-p newname) + (directory-name-p newname)) + (setq newname + (expand-file-name (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (tramp-compat-directory-name-p newname)) - (setq newname - (expand-file-name (file-name-nondirectory filename) newname))) + (not (directory-name-p newname))) + (tramp-error v 'file-error "File is a directory %s" newname)) - (with-parsed-tramp-file-name newname nil - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error v 'file-already-exists newname)) - (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) - (tramp-error v 'file-error "File is a directory %s" newname)) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - (unless (tramp-smb-get-share v) - (tramp-error - v 'file-error "Target `%s' must contain a share name" newname)) - (unless (tramp-smb-send-command - v (format "put \"%s\" \"%s\"" - (tramp-compat-file-name-unquote filename) - (tramp-smb-get-localname v))) - (tramp-error - v 'file-error "Cannot copy `%s' to `%s'" filename newname)))))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + (unless (tramp-smb-get-share v) + (tramp-error + v 'file-error "Target `%s' must contain a share name" newname)) + (unless (tramp-smb-send-command + v (format "put \"%s\" \"%s\"" + (tramp-compat-file-name-unquote filename) + (tramp-smb-get-localname v))) + (tramp-error + v 'file-error "Cannot copy `%s' to `%s'" filename newname))))) ;; KEEP-DATE handling. (when keep-date @@ -1003,7 +1001,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq filename (expand-file-name filename)) (unless switches (setq switches "")) ;; Mark trailing "/". - (when (and (tramp-compat-directory-name-p filename) + (when (and (directory-name-p filename) (not full-directory-p)) (setq switches (concat switches "F"))) (if full-directory-p @@ -1188,9 +1186,7 @@ component is used as the target of the symlink." (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name target)))))) + (setq target (tramp-file-local-name (expand-file-name target))))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -1244,7 +1240,7 @@ component is used as the target of the symlink." (setq infile (expand-file-name infile)) (if (tramp-equal-remote default-directory infile) ;; INFILE is on the same remote host. - (setq input (with-parsed-tramp-file-name infile nil localname)) + (setq input (tramp-file-local-name infile)) ;; INFILE must be copied to remote host. (setq input (tramp-make-tramp-temp-file v) tmpinput (tramp-make-tramp-file-name v input)) @@ -1357,7 +1353,7 @@ component is used as the target of the symlink." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (with-tramp-progress-reporter @@ -1924,11 +1920,9 @@ If ARGUMENT is non-nil, use it as argument for ;; connection timeout. (with-current-buffer buf (goto-char (point-min)) - ;; `seconds-to-time' can be removed once we get rid of Emacs 24. - (when (and (time-less-p (seconds-to-time 60) - (time-since - (tramp-get-connection-property - p "last-cmd-time" (seconds-to-time 0)))) + (when (and (time-less-p + 60 (time-since + (tramp-get-connection-property p "last-cmd-time" 0))) (process-live-p p) (re-search-forward tramp-smb-errors nil t)) (delete-process p) @@ -1994,7 +1988,7 @@ If ARGUMENT is non-nil, use it as argument for (set-process-query-on-exit-flag p nil) (condition-case err - (let (tramp-message-show-message) + (let ((inhibit-message t)) ;; Play login scenario. (tramp-process-actions p vec nil @@ -2132,7 +2126,5 @@ Removes smb prompt. Returns nil if an error message has appeared." ;; ;; * Try to remove the inclusion of dummy "" directory. Seems to be at ;; several places, especially in `tramp-smb-handle-insert-directory'. -;; -;; * Ignore case in file names. ;;; tramp-smb.el ends here diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 08188cefde3..f258ad6b931 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -153,10 +153,9 @@ See `tramp-actions-before-shell' for more info.") "Invoke the SUDOEDIT handler for OPERATION and ARGS. First arg specifies the OPERATION, second arg is a list of arguments to pass to the OPERATION." - (let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###tramp-autoload (tramp--with-startup @@ -248,7 +247,7 @@ absolute file names." (when (and (not ok-if-already-exists) (file-exists-p newname)) (tramp-error v 'file-already-exists newname)) (when (and (file-directory-p newname) - (not (tramp-compat-directory-name-p newname))) + (not (directory-name-p newname))) (tramp-error v 'file-error "File is a directory %s" newname)) (if (or (and (file-remote-p filename) (not t1)) @@ -265,10 +264,8 @@ absolute file names." v 0 (format "%s %s to %s" msg-operation filename newname) (unless (tramp-sudoedit-send-command v sudoedit-operation - (tramp-compat-file-name-unquote - (tramp-compat-file-local-name filename)) - (tramp-compat-file-name-unquote - (tramp-compat-file-local-name newname))) + (tramp-unquote-file-local-name filename) + (tramp-unquote-file-local-name newname)) (tramp-error v 'file-error "Error %s `%s' `%s'" msg-operation filename newname)))) @@ -305,8 +302,8 @@ absolute file names." (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -543,8 +540,7 @@ the result will be a local, non-Tramp, file name." "Like `file-truename' for Tramp files." ;; Preserve trailing "/". (funcall - (if (tramp-compat-directory-name-p filename) - #'file-name-as-directory #'identity) + (if (directory-name-p filename) #'file-name-as-directory #'identity) ;; Quote properly. (funcall (if (tramp-compat-file-name-quoted-p filename) @@ -615,9 +611,7 @@ component is used as the target of the symlink." (let ((non-essential t)) (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p v (tramp-dissect-file-name target))) - (setq target - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name target)))))) + (setq target (tramp-file-local-name (expand-file-name target))))) ;; If TARGET is still remote, quote it. (if (tramp-tramp-file-p target) @@ -646,8 +640,8 @@ component is used as the target of the symlink." (defun tramp-sudoedit-handle-rename-file (filename newname &optional ok-if-already-exists) "Like `rename-file' for Tramp files." - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) ;; At least one file a Tramp file? (if (or (tramp-tramp-file-p filename) (tramp-tramp-file-p newname)) @@ -715,8 +709,7 @@ ID-FORMAT valid values are `string' and `integer'." (format "%d:%d" (or uid (tramp-sudoedit-get-remote-uid v 'integer)) (or gid (tramp-sudoedit-get-remote-gid v 'integer))) - (tramp-compat-file-name-unquote - (tramp-compat-file-local-name filename))))) + (tramp-unquote-file-local-name filename)))) (defun tramp-sudoedit-handle-write-region (start end filename &optional append visit lockname mustbenew) diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el index 6a044e58840..f368f72a8dc 100644 --- a/lisp/net/tramp-uu.el +++ b/lisp/net/tramp-uu.el @@ -94,8 +94,3 @@ (provide 'tramp-uu) ;;; tramp-uu.el ends here - -;; Local Variables: -;; mode: Emacs-Lisp -;; coding: utf-8 -;; End: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0ad65fb8bd0..409e1f7499a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -7,8 +7,8 @@ ;; Maintainer: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.4.3 -;; Package-Requires: ((emacs "24.4")) +;; Version: 2.5.0-pre +;; Package-Requires: ((emacs "25.1")) ;; Package-Type: multi ;; URL: https://savannah.gnu.org/projects/tramp @@ -1258,7 +1258,7 @@ calling HANDLER.") ;; data structure. ;; The basic structure for remote file names. We use a list :type, -;; in order to be compatible with Emacs 24 and 25. +;; in order to be compatible with Emacs 25. (cl-defstruct (tramp-file-name (:type list) :named) method user domain host port localname hop) @@ -1306,9 +1306,10 @@ entry does not exist, return nil." ;; We use the cached property. (tramp-get-connection-property vec hash-entry nil) ;; Use the static value from `tramp-methods'. - (let ((methods-entry - (assoc param (assoc (tramp-file-name-method vec) tramp-methods)))) - (when methods-entry (cadr methods-entry)))))) + (when-let ((methods-entry + (assoc + param (assoc (tramp-file-name-method vec) tramp-methods)))) + (cadr methods-entry))))) ;; The localname can be quoted with "/:". Extract this. (defun tramp-file-name-unquote-localname (vec) @@ -1347,6 +1348,11 @@ of `process-file', `start-file-process', or `shell-command'." (match-string (nth 4 tramp-file-name-structure) name)) (tramp-compat-file-local-name name))) +;; The localname can be quoted with "/:". Extract this. +(defun tramp-unquote-file-local-name (name) + "Return unquoted localname of NAME." + (tramp-compat-file-name-unquote (tramp-file-local-name name))) + (defun tramp-find-method (method user host) "Return the right method string to use depending on USER and HOST. This is METHOD, if non-nil. Otherwise, do a lookup in @@ -1363,8 +1369,8 @@ This is METHOD, if non-nil. Otherwise, do a lookup in (setq item (pop choices)) (when (and (string-match-p (or (nth 0 item) "") (or host "")) (string-match-p (or (nth 1 item) "") (or user ""))) - (setq lmethod (nth 2 item)) - (setq choices nil))) + (setq lmethod (nth 2 item) + choices nil))) lmethod) tramp-default-method))) ;; We must mark, whether a default value has been used. @@ -1384,8 +1390,8 @@ This is USER, if non-nil. Otherwise, do a lookup in (setq item (pop choices)) (when (and (string-match-p (or (nth 0 item) "") (or method "")) (string-match-p (or (nth 1 item) "") (or host ""))) - (setq luser (nth 2 item)) - (setq choices nil))) + (setq luser (nth 2 item) + choices nil))) luser) tramp-default-user))) ;; We must mark, whether a default value has been used. @@ -1405,8 +1411,8 @@ This is HOST, if non-nil. Otherwise, do a lookup in (setq item (pop choices)) (when (and (string-match-p (or (nth 0 item) "") (or method "")) (string-match-p (or (nth 1 item) "") (or user ""))) - (setq lhost (nth 2 item)) - (setq choices nil))) + (setq lhost (nth 2 item) + choices nil))) lhost) tramp-default-host))) ;; We must mark, whether a default value has been used. @@ -1468,7 +1474,7 @@ default values are used." :method method :user user :domain domain :host host :port port :localname localname :hop hop)) ;; The method must be known. - (unless (or nodefault (tramp-completion-mode-p) + (unless (or nodefault non-essential (string-equal method tramp-default-method-marker) (assoc method tramp-methods)) (tramp-user-error @@ -1592,7 +1598,7 @@ necessary only. This function will be used in file name completion." tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host) tramp-postfix-host-format)) - (when localname localname))) + localname)) (defun tramp-get-buffer (vec &optional dont-create) "Get the connection buffer to be used for VEC. @@ -1648,7 +1654,7 @@ version, the function does nothing." "Set connection-local variables in the current buffer. If connection-local variables are not supported by this Emacs version, the function does nothing." - (when (file-remote-p default-directory) + (when (tramp-tramp-file-p default-directory) ;; `hack-connection-local-variables-apply' exists since Emacs 26.1. (tramp-compat-funcall 'hack-connection-local-variables-apply @@ -1744,29 +1750,10 @@ ARGUMENTS to actually emit the message (if applicable)." (setq btf (nth 1 (backtrace-frame btn))) (if (not btf) (setq fn "") - (when (symbolp btf) - (setq fn (symbol-name btf)) - (unless - (and - (string-match-p "^tramp" fn) - (not - (string-match-p - (eval-when-compile - (concat - "^" - (regexp-opt - '("tramp-backtrace" - "tramp-compat-funcall" - "tramp-debug-message" - "tramp-error" - "tramp-error-with-buffer" - "tramp-message" - "tramp-signal-hook-function" - "tramp-user-error") - t) - "$")) - fn))) - (setq fn nil))) + (and (symbolp btf) (setq fn (symbol-name btf)) + (or (not (string-match-p "^tramp" fn)) + (get btf 'tramp-suppress-trace)) + (setq fn nil)) (setq btn (1+ btn)))) ;; The following code inserts filename and line number. Should ;; be inactive by default, because it is time consuming. @@ -1781,11 +1768,7 @@ ARGUMENTS to actually emit the message (if applicable)." ;; The message. (insert (apply #'format-message fmt-string arguments)))) -(defvar tramp-message-show-message (null noninteractive) - "Show Tramp message in the minibuffer. -This variable is used to suppress progress reporter output, and -to disable messages from `tramp-error'. Those messages are -visible anyway, because an error is raised.") +(put #'tramp-debug-message 'tramp-suppress-trace t) (defsubst tramp-message (vec-or-proc level fmt-string &rest arguments) "Emit a message depending on verbosity level. @@ -1803,7 +1786,7 @@ applicable)." (ignore-errors (when (<= level tramp-verbose) ;; Display only when there is a minimum level. - (when (and tramp-message-show-message (<= level 3)) + (when (<= level 3) (apply #'message (concat (cond @@ -1835,6 +1818,8 @@ applicable)." (concat (format "(%d) # " level) fmt-string) arguments)))))) +(put #'tramp-message 'tramp-suppress-trace t) + (defsubst tramp-backtrace (&optional vec-or-proc) "Dump a backtrace into the debug buffer. If VEC-OR-PROC is nil, the buffer *debug tramp* is used. This @@ -1845,13 +1830,16 @@ function is meant for debugging purposes." vec-or-proc 10 "\n%s" (with-output-to-string (backtrace))) (with-output-to-temp-buffer "*debug tramp*" (backtrace))))) +(put #'tramp-backtrace 'tramp-suppress-trace t) + (defsubst tramp-error (vec-or-proc signal fmt-string &rest arguments) "Emit an error. VEC-OR-PROC identifies the connection to use, SIGNAL is the signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised with FMT-STRING and ARGUMENTS." - (let (tramp-message-show-message signal-hook-function) + (let ((inhibit-message t) + signal-hook-function) (tramp-backtrace vec-or-proc) (unless arguments ;; FMT-STRING could be just a file name, as in @@ -1869,6 +1857,8 @@ FMT-STRING and ARGUMENTS." (signal signal (list (substring-no-properties (apply #'format-message fmt-string arguments)))))) +(put #'tramp-error 'tramp-suppress-trace t) + (defsubst tramp-error-with-buffer (buf vec-or-proc signal fmt-string &rest arguments) "Emit an error, and show BUF. @@ -1886,13 +1876,13 @@ an input event arrives. The other arguments are passed to `tramp-error'." (apply #'tramp-error vec-or-proc signal fmt-string arguments) ;; Save exit. (when (and buf - tramp-message-show-message (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. - (not (tramp-completion-mode-p)) + (not non-essential) ;; Show only when Emacs has started already. (current-message)) - (let ((enable-recursive-minibuffers t)) + (let ((enable-recursive-minibuffers t) + inhibit-message) ;; `tramp-error' does not show messages. So we must do it ;; ourselves. (apply #'message fmt-string arguments) @@ -1904,19 +1894,21 @@ an input event arrives. The other arguments are passed to `tramp-error'." (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) +(put #'tramp-error-with-buffer 'tramp-suppress-trace t) + ;; We must make it a defun, because it is used earlier already. (defun tramp-user-error (vec-or-proc fmt-string &rest arguments) "Signal a user error (or \"pilot error\")." (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. - (when (and tramp-message-show-message - (not (zerop tramp-verbose)) + (when (and (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. - (not (tramp-completion-mode-p)) + (not non-essential) ;; Show only when Emacs has started already. (current-message)) - (let ((enable-recursive-minibuffers t)) + (let ((enable-recursive-minibuffers t) + inhibit-message) ;; `tramp-error' does not show messages. So we must do it ourselves. (apply #'message fmt-string arguments) (discard-input) @@ -1926,18 +1918,21 @@ an input event arrives. The other arguments are passed to `tramp-error'." (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) +(put #'tramp-user-error 'tramp-suppress-trace t) + (defmacro tramp-with-demoted-errors (vec-or-proc format &rest body) "Execute BODY while redirecting the error message to `tramp-message'. BODY is executed like wrapped by `with-demoted-errors'. FORMAT is a format-string containing a %-sequence meaning to substitute the resulting error message." - (declare (debug (symbolp body)) - (indent 2)) + (declare (indent 2) (debug (symbolp form body))) (let ((err (make-symbol "err"))) `(condition-case-unless-debug ,err (progn ,@body) (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) +(put #'tramp-with-demoted-errors 'tramp-suppress-trace t) + ;; This function provides traces in case of errors not triggered by ;; Tramp functions. (defun tramp-signal-hook-function (error-symbol data) @@ -1949,6 +1944,8 @@ the resulting error message." (car tramp-current-connection) error-symbol "%s" (mapconcat (lambda (x) (format "%s" x)) data " ")))) +(put #'tramp-signal-hook-function 'tramp-suppress-trace t) + (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. @@ -1965,12 +1962,14 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit If VAR is nil, then we bind `v' to the structure and `method', `user', `domain', `host', `port', `localname', `hop' to the components." + (declare (indent 2) (debug (form symbolp body))) (let ((bindings - (mapcar (lambda (elem) - `(,(if var (intern (format "%s-%s" var elem)) elem) - (,(intern (format "tramp-file-name-%s" elem)) - ,(or var 'v)))) - `,(tramp-compat-tramp-file-name-slots)))) + (mapcar + (lambda (elem) + `(,(if var (intern (format "%s-%s" var elem)) elem) + (,(intern (format "tramp-file-name-%s" elem)) + ,(or var 'v)))) + (cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))))) `(let* ((,(or var 'v) (tramp-dissect-file-name ,filename)) ,@bindings) ;; We don't know which of those vars will be used, so we bind them all, @@ -1979,8 +1978,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (ignore ,@(mapcar #'car bindings)) ,@body))) -(put 'with-parsed-tramp-file-name 'lisp-indent-function 2) -(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) (defun tramp-progress-reporter-update (reporter &optional value suffix) @@ -1991,22 +1988,20 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (tramp-compat-progress-reporter-update reporter value suffix)))) (defmacro with-tramp-progress-reporter (vec level message &rest body) - "Execute BODY, spinning a progress reporter with MESSAGE. + "Execute BODY, spinning a progress reporter with MESSAGE in interactive mode. If LEVEL does not fit for visible messages, there are only traces without a visible progress reporter." (declare (indent 3) (debug t)) - `(progn + `(if (or noninteractive inhibit-message) + (progn ,@body) (tramp-message ,vec ,level "%s..." ,message) (let ((cookie "failed") (tm - ;; We start a pulsing progress reporter after 3 seconds. - (when (and tramp-message-show-message - ;; Display only when there is a minimum level. - (<= ,level (min tramp-verbose 3))) - (let ((pr (make-progress-reporter ,message nil nil))) - (when pr - (run-at-time - 3 0.1 #'tramp-progress-reporter-update pr)))))) + ;; We start a pulsing progress reporter after 3 + ;; seconds. Display only when there is a minimum level. + (when-let ((pr (and (<= ,level (min tramp-verbose 3)) + (make-progress-reporter ,message nil nil)))) + (run-at-time 3 0.1 #'tramp-progress-reporter-update pr)))) (unwind-protect ;; Execute the body. (prog1 (progn ,@body) (setq cookie "done")) @@ -2020,6 +2015,7 @@ without a visible progress reporter." (defmacro with-tramp-file-property (vec file property &rest body) "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. FILE must be a local file name on a connection identified via VEC." + (declare (indent 3) (debug t)) `(if (file-name-absolute-p ,file) (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) (when (eq value 'undef) @@ -2031,12 +2027,11 @@ FILE must be a local file name on a connection identified via VEC." value) ,@body)) -(put 'with-tramp-file-property 'lisp-indent-function 3) -(put 'with-tramp-file-property 'edebug-form-spec t) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-file-property\\>")) (defmacro with-tramp-connection-property (key property &rest body) "Check in Tramp for property PROPERTY, otherwise execute BODY and set." + (declare (indent 2) (debug t)) `(let ((value (tramp-get-connection-property ,key ,property 'undef))) (when (eq value 'undef) ;; We cannot pass ,@body as parameter to @@ -2046,8 +2041,6 @@ FILE must be a local file name on a connection identified via VEC." (tramp-set-connection-property ,key ,property value)) value)) -(put 'with-tramp-connection-property 'lisp-indent-function 2) -(put 'with-tramp-connection-property 'edebug-form-spec t) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-tramp-connection-property\\>")) @@ -2066,6 +2059,9 @@ letter into the file name. This function removes it." ;;; Config Manipulation Functions: +(defconst tramp-dns-sd-service-regexp "^_[-[:alnum:]]+\\._tcp$" + "DNS-SD service regexp.") + (defun tramp-set-completion-function (method function-list) "Set the list of completion functions for METHOD. FUNCTION-LIST is a list of entries of the form (FUNCTION FILE). @@ -2098,10 +2094,10 @@ Example: (zerop (tramp-call-process v "reg" nil nil nil "query" (nth 1 (car v)))))) - ;; Zeroconf service type. + ;; DNS-SD service type. ((string-match-p - "^_[[:alpha:]]+\\._[[:alpha:]]+$" (nth 1 (car v)))) - ;; Configuration file. + tramp-dns-sd-service-regexp (nth 1 (car v)))) + ;; Configuration file or empty string. (t (file-exists-p (nth 1 (car v)))))) (setq r (delete (car v) r))) (setq v (cdr v))) @@ -2267,10 +2263,7 @@ Must be handled by the callers." exec-path make-process)) default-directory) ;; PROC. - ((member operation - '(file-notify-rm-watch - ;; Emacs 25+ only. - file-notify-valid-p)) + ((member operation '(file-notify-rm-watch file-notify-valid-p)) (when (processp (nth 0 args)) (with-current-buffer (process-buffer (nth 0 args)) default-directory))) @@ -2390,7 +2383,7 @@ Fall back to normal file name handler if no Tramp file name handler exists." (cons operation args)) (tramp-run-real-handler operation args)) ((eq result 'suppress) - (let (tramp-message-show-message) + (let ((inhibit-message t)) (tramp-message v 1 "Suppress received in operation %s" (cons operation args)) @@ -2419,18 +2412,19 @@ Fall back to normal file name handler if no Tramp file name handler exists." (defun tramp-completion-file-name-handler (operation &rest args) "Invoke Tramp file name completion handler for OPERATION and ARGS. Falls back to normal file name handler if no Tramp file name handler exists." - (let ((fn (assoc operation tramp-completion-file-name-handler-alist))) - (if (and fn tramp-mode) - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) + (if-let + ((fn (and tramp-mode + (assoc operation tramp-completion-file-name-handler-alist)))) + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args))) ;;;###autoload (progn (defun tramp-autoload-file-name-handler (operation &rest args) "Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) - (if tramp-mode - (let ((default-directory temporary-file-directory)) - (load "tramp" 'noerror 'nomessage))) + (when tramp-mode + (let ((default-directory temporary-file-directory)) + (load "tramp" 'noerror 'nomessage))) (apply operation args))) ;; `tramp-autoload-file-name-handler' must be registered before @@ -2442,7 +2436,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp 'tramp-autoload-file-name-handler)) - (put 'tramp-autoload-file-name-handler 'safe-magic t))) + (put #'tramp-autoload-file-name-handler 'safe-magic t))) ;;;###autoload (tramp-register-autoload-file-name-handlers) @@ -2483,29 +2477,28 @@ remote file names." ;; respective foreign handlers. (add-to-list 'file-name-handler-alist (cons tramp-file-name-regexp #'tramp-file-name-handler)) - (put 'tramp-file-name-handler 'safe-magic t) + (put #'tramp-file-name-handler 'safe-magic t) (add-to-list 'file-name-handler-alist (cons tramp-completion-file-name-regexp #'tramp-completion-file-name-handler)) - (put 'tramp-completion-file-name-handler 'safe-magic t) + (put #'tramp-completion-file-name-handler 'safe-magic t) ;; Mark `operations' the handler is responsible for. - (put 'tramp-completion-file-name-handler 'operations + (put #'tramp-completion-file-name-handler 'operations (mapcar #'car tramp-completion-file-name-handler-alist)) (when (bound-and-true-p tramp-archive-enabled) (add-to-list 'file-name-handler-alist (cons tramp-archive-file-name-regexp #'tramp-archive-file-name-handler)) - (put 'tramp-archive-file-name-handler 'safe-magic t)) + (put #'tramp-archive-file-name-handler 'safe-magic t)) ;; If jka-compr or epa-file are already loaded, move them to the ;; front of `file-name-handler-alist'. (dolist (fnh '(epa-file-handler jka-compr-handler)) - (let ((entry (rassoc fnh file-name-handler-alist))) - (when entry - (setq file-name-handler-alist - (cons entry (delete entry file-name-handler-alist))))))) + (when-let ((entry (rassoc fnh file-name-handler-alist))) + (setq file-name-handler-alist + (cons entry (delete entry file-name-handler-alist)))))) (tramp--with-startup (tramp-register-file-name-handlers)) @@ -2517,7 +2510,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." (add-to-list 'tramp-foreign-file-name-handler-alist `(,func . ,handler) append) ;; Mark `operations' the handler is responsible for. - (put 'tramp-file-name-handler + (put #'tramp-file-name-handler 'operations (delete-dups (append @@ -2558,24 +2551,11 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." ;;; File name handler functions for completion mode: -;;;###autoload -(defvar tramp-completion-mode nil - "If non-nil, external packages signal that they are in file name completion.") -(make-obsolete-variable 'tramp-completion-mode 'non-essential "26.1") - -(defun tramp-completion-mode-p () - "Check, whether method / user name / host name completion is active." - (or - ;; Signal from outside. - non-essential - ;; This variable has been obsoleted in Emacs 26. - tramp-completion-mode)) - (defun tramp-connectable-p (vec-or-filename) "Check, whether it is possible to connect the remote host w/o side-effects. This is true, if either the remote host is already connected, or if we are not in completion mode." - (let (tramp-verbose + (let ((tramp-verbose 0) (vec (cond ((tramp-file-name-p vec-or-filename) vec-or-filename) @@ -2585,7 +2565,7 @@ not in completion mode." ;; `tramp-buffer-name'; otherwise `start-file-process' ;; wouldn't run ever when `non-essential' is non-nil. (and vec (process-live-p (get-process (tramp-buffer-name vec)))) - (not (tramp-completion-mode-p))))) + (not non-essential)))) ;; Method, host name and user name completion. ;; `tramp-completion-dissect-file-name' returns a list of @@ -2864,7 +2844,7 @@ User is always nil." (let ((default-directory (tramp-compat-temporary-file-directory))) (when (file-readable-p filename) (with-temp-buffer - (insert-file-contents filename) + (insert-file-contents-literally filename) (goto-char (point-min)) (cl-loop while (not (eobp)) collect (funcall function)))))) @@ -2876,7 +2856,7 @@ Either user or host may be nil." (defun tramp-parse-rhosts-group () "Return a (user host) tuple allowed to access. Either user or host may be nil." - (let ((result) + (let (result (regexp (concat "^\\(" tramp-host-regexp "\\)" @@ -2961,7 +2941,7 @@ Host is always \"localhost\"." (defun tramp-parse-passwd-group () "Return a (user host) tuple allowed to access. Host is always \"localhost\"." - (let ((result) + (let (result (regexp (concat "^\\(" tramp-user-regexp "\\):"))) (when (re-search-forward regexp (point-at-eol) t) (setq result (list (match-string 1) "localhost"))) @@ -2983,7 +2963,7 @@ Host is always \"localhost\"." (defun tramp-parse-etc-group-group () "Return a (group host) tuple allowed to access. Host is always \"localhost\"." - (let ((result) + (let (result (split (split-string (buffer-substring (point) (point-at-eol)) ":"))) (when (member (user-login-name) (split-string (nth 3 split) "," 'omit)) (setq result (list (nth 0 split) "localhost"))) @@ -3020,7 +3000,7 @@ User is always nil." (defun tramp-parse-putty-group (registry) "Return a (user host) tuple allowed to access. User is always nil." - (let ((result) + (let (result (regexp (concat (regexp-quote registry) "\\\\\\(.+\\)"))) (when (re-search-forward regexp (point-at-eol) t) (setq result (list nil (match-string 1)))) @@ -3201,10 +3181,8 @@ User is always nil." (defun tramp-handle-file-modes (filename) "Like `file-modes' for Tramp files." - ;; Starting with Emacs 25.1, `when-let' can be used. - (let ((attrs (file-attributes (or (file-truename filename) filename)))) - (when attrs - (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs))))) + (when-let ((attrs (file-attributes (or (file-truename filename) filename)))) + (tramp-mode-string-to-int (tramp-compat-file-attribute-modes attrs)))) ;; Localname manipulation functions that grok Tramp localnames... (defun tramp-handle-file-name-as-directory (file) @@ -3247,7 +3225,7 @@ User is always nil." ;; lower case letters. This avoids us to create a ;; temporary file. (while (and (string-match-p - "[a-z]" (tramp-compat-file-local-name candidate)) + "[a-z]" (tramp-file-local-name candidate)) (not (file-exists-p candidate))) (setq candidate (directory-file-name @@ -3257,8 +3235,7 @@ User is always nil." ;; to Emacs 26+ like `file-name-case-insensitive-p', ;; so there is no compatibility problem calling it. (unless - (string-match-p - "[a-z]" (tramp-compat-file-local-name candidate)) + (string-match-p "[a-z]" (tramp-file-local-name candidate)) (setq tmpfile (let ((default-directory (file-name-directory filename))) @@ -3271,7 +3248,7 @@ User is always nil." (file-exists-p (concat (file-remote-p candidate) - (upcase (tramp-compat-file-local-name candidate)))) + (upcase (tramp-file-local-name candidate)))) ;; Cleanup. (when tmpfile (delete-file tmpfile))))))))))) @@ -3323,21 +3300,18 @@ User is always nil." (cond ((not (file-exists-p file1)) nil) ((not (file-exists-p file2)) t) - (t (time-less-p (tramp-compat-file-attribute-modification-time - (file-attributes file2)) - (tramp-compat-file-attribute-modification-time - (file-attributes file1)))))) + (t (time-less-p + (tramp-compat-file-attribute-modification-time (file-attributes file2)) + (tramp-compat-file-attribute-modification-time + (file-attributes file1)))))) (defun tramp-handle-file-regular-p (filename) "Like `file-regular-p' for Tramp files." (and (file-exists-p filename) ;; Sometimes, `file-attributes' does not return a proper value ;; even if `file-exists-p' does. - (ignore-errors - (eq ?- - (aref - (tramp-compat-file-attribute-modes (file-attributes filename)) - 0))))) + (when-let ((attr (file-attributes filename))) + (eq ?- (aref (tramp-compat-file-attribute-modes attr) 0))))) (defun tramp-handle-file-remote-p (filename &optional identification connected) "Like `file-remote-p' for Tramp files." @@ -3376,8 +3350,7 @@ User is always nil." "Like `file-truename' for Tramp files." ;; Preserve trailing "/". (funcall - (if (tramp-compat-directory-name-p filename) - #'file-name-as-directory #'identity) + (if (directory-name-p filename) #'file-name-as-directory #'identity) ;; Quote properly. (funcall (if (tramp-compat-file-name-quoted-p filename) @@ -3413,7 +3386,7 @@ User is always nil." (tramp-error v1 'file-error "Maximum number (%d) of symlinks exceeded" numchase-limit))) - (tramp-compat-file-local-name (directory-file-name result))))))))) + (tramp-file-local-name (directory-file-name result))))))))) (defun tramp-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." @@ -3448,7 +3421,7 @@ User is always nil." "Like `insert-directory' for Tramp files." (unless switches (setq switches "")) ;; Mark trailing "/". - (when (and (tramp-compat-directory-name-p filename) + (when (and (directory-name-p filename) (not full-directory-p)) (setq switches (concat switches "F"))) ;; Check, whether directory is accessible. @@ -3458,7 +3431,7 @@ User is always nil." (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) (let (ls-lisp-use-insert-directory-program start) ;; Silence byte compiler. - ls-lisp-use-insert-directory-program + (ignore ls-lisp-use-insert-directory-program) (tramp-run-real-handler #'insert-directory (list filename switches wildcard full-directory-p)) @@ -3582,8 +3555,8 @@ User is always nil." ;; Save exit. (progn (when visit - (setq buffer-file-name filename) - (setq buffer-read-only (not (file-writable-p filename))) + (setq buffer-file-name filename + buffer-read-only (not (file-writable-p filename))) (set-visited-file-modtime) (set-buffer-modified-p nil)) (when (and (stringp local-copy) @@ -3617,7 +3590,7 @@ User is always nil." v tramp-file-missing "Cannot load nonexistent file `%s'" file)) (if (not (file-exists-p file)) nil - (let ((tramp-message-show-message (not nomessage))) + (let ((inhibit-message nomessage)) (with-tramp-progress-reporter v 0 (format "Loading %s" file) (let ((local-copy (file-local-copy file))) (unwind-protect @@ -3645,10 +3618,16 @@ support symbolic links." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) (command (substring command 0 asynchronous)) current-buffer-p + (output-buffer-p output-buffer) (output-buffer (cond - ((bufferp output-buffer) output-buffer) - ((stringp output-buffer) (get-buffer-create output-buffer)) + ((bufferp output-buffer) + (setq current-buffer-p (eq (current-buffer) output-buffer)) + output-buffer) + ((stringp output-buffer) + (setq current-buffer-p + (eq (buffer-name (current-buffer)) output-buffer)) + (get-buffer-create output-buffer)) (output-buffer (setq current-buffer-p t) (current-buffer)) @@ -3660,13 +3639,19 @@ support symbolic links." (cond ((bufferp error-buffer) error-buffer) ((stringp error-buffer) (get-buffer-create error-buffer)))) + (error-file + (and error-buffer + (with-parsed-tramp-file-name default-directory nil + (tramp-make-tramp-file-name + v (tramp-make-tramp-temp-file v))))) (bname (buffer-name output-buffer)) (p (get-buffer-process output-buffer)) + (dir default-directory) buffer) ;; The following code is taken from `shell-command', slightly ;; adapted. Shouldn't it be factored out? - (when p + (when (and (integerp asynchronous) p) (cond ((eq async-shell-command-buffer 'confirm-kill-process) ;; If will kill a process, query first. @@ -3698,22 +3683,25 @@ support symbolic links." (rename-uniquely)) (setq output-buffer (get-buffer-create bname))))) - (setq buffer (if (and (not asynchronous) error-buffer) - (with-parsed-tramp-file-name default-directory nil - (list output-buffer - (tramp-make-tramp-file-name - v (tramp-make-tramp-temp-file v)))) - output-buffer)) - - (if current-buffer-p - (progn - (barf-if-buffer-read-only) - (push-mark nil t)) + (unless output-buffer-p (with-current-buffer output-buffer + (setq default-directory dir))) + + (setq buffer (if error-file (list output-buffer error-file) output-buffer)) + + (with-current-buffer output-buffer + (when current-buffer-p + (barf-if-buffer-read-only) + (push-mark nil t)) + ;; `shell-command-save-pos-or-erase' has been introduced with + ;; Emacs 27.1. + (if (fboundp 'shell-command-save-pos-or-erase) + (tramp-compat-funcall + 'shell-command-save-pos-or-erase current-buffer-p) (setq buffer-read-only nil) (erase-buffer))) - (if (and (not current-buffer-p) (integerp asynchronous)) + (if (integerp asynchronous) (let ((tramp-remote-process-environment ;; `async-shell-command-width' has been introduced with ;; Emacs 27.1. @@ -3726,42 +3714,68 @@ support symbolic links." ;; Run the process. (setq p (start-file-process-shell-command (buffer-name output-buffer) buffer command)) - ;; Display output. - (with-current-buffer output-buffer - (display-buffer output-buffer '(nil (allow-no-window . t))) - (setq mode-line-process '(":%s")) - (shell-mode) - (set-process-sentinel p #'shell-command-sentinel) - (set-process-filter p #'comint-output-filter)))) + ;; Insert error messages if they were separated. + (when error-file + (with-current-buffer error-buffer + (insert-file-contents-literally error-file))) + (if (process-live-p p) + ;; Display output. + (with-current-buffer output-buffer + (setq mode-line-process '(":%s")) + (unless (eq major-mode 'shell-mode) + (shell-mode)) + (set-process-filter p #'comint-output-filter) + (set-process-sentinel p #'shell-command-sentinel) + (when error-file + (add-function + :after (process-sentinel p) + (lambda (_proc _string) + (with-current-buffer error-buffer + (insert-file-contents-literally + error-file nil nil nil 'replace)) + (delete-file error-file)))) + (display-buffer output-buffer '(nil (allow-no-window . t)))) + + (when error-file + (delete-file error-file))))) (prog1 ;; Run the process. (process-file-shell-command command nil buffer nil) ;; Insert error messages if they were separated. - (when (listp buffer) + (when error-file (with-current-buffer error-buffer - (insert-file-contents (cadr buffer))) - (delete-file (cadr buffer))) + (insert-file-contents-literally error-file)) + (delete-file error-file)) (if current-buffer-p ;; This is like exchange-point-and-mark, but doesn't ;; activate the mark. It is cleaner to avoid activation, ;; even though the command loop would deactivate the mark ;; because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) - (current-buffer)))) + (progn + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) + (current-buffer)))) + ;; `shell-command-set-point-after-cmd' has been + ;; introduced with Emacs 27.1. + (if (fboundp 'shell-command-set-point-after-cmd) + (tramp-compat-funcall + 'shell-command-set-point-after-cmd))) ;; There's some output, display it. (when (with-current-buffer output-buffer (> (point-max) (point-min))) (display-message-or-buffer output-buffer))))))) (defun tramp-handle-start-file-process (name buffer program &rest args) - "Like `start-file-process' for Tramp files." + "Like `start-file-process' for Tramp files. +BUFFER might be a list, in this case STDERR is separated." ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only. (tramp-file-name-handler 'make-process :name name - :buffer buffer + :buffer (if (consp buffer) (car buffer) buffer) :command (and program (cons program args)) + ;; `shell-command' adds an errfile to `buffer'. + :stderr (when (consp buffer) (cadr buffer)) :noquery nil :file-handler t)) @@ -4083,9 +4097,9 @@ See `tramp-process-actions' for the format of ACTIONS." (while (tramp-accept-process-output proc 0)) (setq todo actions) (while todo - (setq item (pop todo)) - (setq pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item)))) - (setq action (nth 1 item)) + (setq item (pop todo) + pattern (format "\\(%s\\)\\'" (symbol-value (nth 0 item))) + action (nth 1 item)) (tramp-message vec 5 "Looking for regexp \"%s\" from remote shell" pattern) (when (tramp-check-for-regexp proc pattern) @@ -4135,9 +4149,8 @@ performed successfully. Any other value means an error." (catch 'tramp-action (tramp-process-one-action proc vec actions))))) (while (not exit) - (setq exit - (catch 'tramp-action - (tramp-process-one-action proc vec actions))))) + (setq exit (catch 'tramp-action + (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) (widen) (tramp-message vec 6 "\n%s" (buffer-string))) @@ -4362,7 +4375,7 @@ would yield t. On the other hand, the following check results in nil: (tramp-equal-remote \"/sudo::/etc\" \"/su::/etc\") If both files are local, the function returns t." - (or (and (null (file-remote-p file1)) (null (file-remote-p file2))) + (or (and (null (tramp-tramp-file-p file1)) (null (tramp-tramp-file-p file2))) (and (tramp-tramp-file-p file1) (tramp-tramp-file-p file2) (string-equal (file-remote-p file1) (file-remote-p file2))))) @@ -4455,9 +4468,9 @@ This is used to map a mode number to a permission string.") (suid (> (logand (ash mode -9) 4) 0)) (sgid (> (logand (ash mode -9) 2) 0)) (sticky (> (logand (ash mode -9) 1) 0))) - (setq user (tramp-file-mode-permissions user suid "s")) - (setq group (tramp-file-mode-permissions group sgid "s")) - (setq other (tramp-file-mode-permissions other sticky "t")) + (setq user (tramp-file-mode-permissions user suid "s") + group (tramp-file-mode-permissions group sgid "s") + other (tramp-file-mode-permissions other sticky "t")) (concat type user group other))) (defun tramp-file-mode-permissions (perm suid suid-text) @@ -4487,16 +4500,15 @@ If FILENAME is remote, a file name handler is called." (when (and modes (not (zerop (logand modes #o2000)))) (setq gid (tramp-compat-file-attribute-group-id (file-attributes dir))))) - (let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid))) - (if handler - (funcall handler #'tramp-set-file-uid-gid filename uid gid) - ;; On W32 systems, "chown" does not work. - (unless (memq system-type '(ms-dos windows-nt)) - (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) - (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer)))) - (tramp-call-process - nil "chown" nil nil nil (format "%d:%d" uid gid) - (tramp-unquote-shell-quote-argument filename))))))) + (if-let ((handler (find-file-name-handler filename 'tramp-set-file-uid-gid))) + (funcall handler #'tramp-set-file-uid-gid filename uid gid) + ;; On W32 systems, "chown" does not work. + (unless (memq system-type '(ms-dos windows-nt)) + (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) + (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer)))) + (tramp-call-process + nil "chown" nil nil nil (format "%d:%d" uid gid) + (tramp-unquote-shell-quote-argument filename)))))) (defun tramp-get-local-uid (id-format) "The uid of the local user, in ID-FORMAT. @@ -4632,7 +4644,7 @@ This handles also chrooted environments, which are not regarded as local." (tramp-make-tramp-file-name vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp")))) (or (and (file-directory-p dir) (file-writable-p dir) - (tramp-compat-file-local-name dir)) + (tramp-file-local-name dir)) (tramp-error vec 'file-error "Directory %s not accessible" dir)) dir))) @@ -4655,7 +4667,7 @@ Return the local name of the temporary file." (set-file-modes result #o0700))) ;; Return the local part. - (with-parsed-tramp-file-name result nil localname))) + (tramp-file-local-name result))) (defun tramp-delete-temp-file-function () "Remove temporary files related to current buffer." @@ -4682,7 +4694,7 @@ this file, if that variable is non-nil." (let ((system-type (if (and (stringp tramp-auto-save-directory) - (file-remote-p tramp-auto-save-directory)) + (tramp-tramp-file-p tramp-auto-save-directory)) 'not-windows system-type)) (auto-save-file-name-transforms @@ -4820,11 +4832,29 @@ verbosity of 6." (tramp-message vec 6 "%s" result) result)) +(defun tramp-process-running-p (process-name) + "Return t if system process PROCESS-NAME is running for `user-login-name'." + (when (stringp process-name) + (catch 'result + (dolist (pid (tramp-compat-funcall 'list-system-processes)) + (let ((attributes (process-attributes pid))) + (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) + (when-let ((comm (cdr (assoc 'comm attributes)))) + ;; The returned command name could be truncated to 15 + ;; characters. Therefore, we cannot check for `string-equal'. + (string-prefix-p comm process-name)) + (throw 'result t))))))) + (defun tramp-read-passwd (proc &optional prompt) "Read a password from user (compat function). Consults the auth-source package. Invokes `password-read' if available, `read-passwd' else." - (let* ((case-fold-search t) + (let* (;; If `auth-sources' contains "~/.authinfo.gpg", and + ;; `exec-path' contains a relative file name like ".", it + ;; could happen that the "gpg" command is not found. So we + ;; adapt `default-directory'. (Bug#39389, Bug#39489) + (default-directory (tramp-compat-temporary-file-directory)) + (case-fold-search t) (key (tramp-make-tramp-file-name ;; In tramp-sh.el, we must use "password-vector" due to ;; multi-hop. @@ -4976,10 +5006,12 @@ name of a process or buffer, or nil to default to the current buffer." (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). + ;; Not all "kill" implementations support process groups by + ;; negative pid, so we try both variants. (tramp-compat-funcall 'tramp-send-command (process-get proc 'vector) - (format "kill -2 -%d" pid)) + (format "(\\kill -2 -%d || \\kill -2 %d) 2>/dev/null" pid pid)) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. (while (tramp-accept-process-output proc 0)) @@ -5034,16 +5066,5 @@ name of a process or buffer, or nil to default to the current buffer." ;; and friends, for most of the handlers this is the major ;; difference between the different backends. Other handlers but ;; *-process-file would profit from this as well. -;; -;; * Get rid of `shell-command'. In its primary implementation, it -;; uses `process-file-shell-command' and -;; `start-file-process-shell-command', which is sufficient due to -;; connection-local `shell-file-name'. - ;;; tramp.el ends here - -;; Local Variables: -;; mode: Emacs-Lisp -;; coding: utf-8 -;; End: diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index dacdd44102f..0a92e0d3202 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -35,11 +35,8 @@ ;; Emacs version check is defined in macro AC_EMACS_INFO of ;; aclocal.m4; should be changed only there. -;; Needed for Emacs 24. -(defvar inhibit-message) - ;;;###tramp-autoload -(defconst tramp-version "2.4.3.27.1" +(defconst tramp-version "2.5.0-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -71,9 +68,9 @@ "The repository revision of the Tramp sources.") ;; Check for Emacs version. -(let ((x (if (not (string-lessp emacs-version "24.4")) +(let ((x (if (not (string-lessp emacs-version "25.1")) "ok" - (format "Tramp 2.4.3.27.1 is not fit for %s" + (format "Tramp 2.5.0-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) @@ -102,8 +99,3 @@ (provide 'trampver) ;;; trampver.el ends here - -;; Local Variables: -;; mode: Emacs-Lisp -;; coding: utf-8 -;; End: diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el index fbf80692037..40532ea5b9d 100644 --- a/lisp/obsolete/cust-print.el +++ b/lisp/obsolete/cust-print.el @@ -156,10 +156,7 @@ If nil, printing proceeds recursively and may lead to If non-nil, shared substructures anywhere in the structure are printed with `#N=' before the first occurrence (in the order of the print representation) and `#N#' in place of each subsequent occurrence, -where N is a positive decimal integer. - -There is no way to read this representation in standard Emacs, -but if you need to do so, try the cl-read.el package." +where N is a positive decimal integer." :type 'boolean :group 'cust-print) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 350eabdb0c1..96b063be701 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1393,7 +1393,7 @@ Copied from `icomplete-tidy'." "Move the summaries to the end of the list. This is an example function which can be hooked on to `iswitchb-make-buflist-hook'. Any buffer matching the regexps -`Summary' or `output\*$'are put to the end of the list." +`Summary' or `output\\*$'are put to the end of the list." (let ((summaries (delq nil (mapcar (lambda (x) diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index 95010c00200..2f46d7ddda5 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -383,10 +383,10 @@ To disable timer scans, set this to zero." (defun whitespace-buffer (&optional quiet) "Find five different types of white spaces in buffer. These are: -1. Leading space \(empty lines at the top of a file\). -2. Trailing space \(empty lines at the end of a file\). -3. Indentation space \(8 or more spaces, that should be replaced with TABS\). -4. Spaces followed by a TAB. \(Almost always, we never want that\). +1. Leading space \(empty lines at the top of a file). +2. Trailing space \(empty lines at the end of a file). +3. Indentation space \(8 or more spaces, that should be replaced with TABS). +4. Spaces followed by a TAB. \(Almost always, we never want that). 5. Spaces or TABS at the end of a line. Check for whitespace only if this buffer really contains a non-empty file diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index 5ef8be20d98..6d95b7136b1 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -89,7 +89,7 @@ nil means use the value returned by \\[user-login-name]." "Command to run before compilation. This can be used for setting up environment variables, since rsh does not invoke the shell as a login shell and files like .login -\(tcsh\) and .bash_profile \(bash\) are not run. +\(tcsh) and .bash_profile \(bash) are not run. nil means run no commands." :type '(choice string (const nil)) :group 'remote-compile) diff --git a/lisp/obsolete/sb-image.el b/lisp/obsolete/sb-image.el new file mode 100644 index 00000000000..fd8884738d4 --- /dev/null +++ b/lisp/obsolete/sb-image.el @@ -0,0 +1,46 @@ +;;; sb-image --- Image management for speedbar + +;; Copyright (C) 1999-2003, 2005-2019 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Keywords: file, tags, tools +;; Obsolete-since: 28.1 + +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file is obsolete. +;; +;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs, +;; is a challenging task, which doesn't take kindly to being byte compiled. +;; When sharing speedbar.elc between these three applications, the Image +;; support can get lost. +;; +;; By splitting out that hard part into this file, and avoiding byte +;; compilation, one copy speedbar can support all these platforms together. +;; +;; This file requires the `image' package if it is available. + +(require 'ezimage) + +;;; Code: + +(defalias 'defimage-speedbar 'defezimage) + +(provide 'sb-image) + +;;; sb-image.el ends here diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index df5ddfdbcf9..eee00b43a26 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -1225,7 +1225,7 @@ SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." (defun vi-end-of-blank-delimited-word (count) "Forward to the end of the COUNT'th blank-delimited word." (interactive "p") - (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count) + (if (re-search-forward "[^ \t\n']+[ \t\n']" nil t count) (if (not (eobp)) (backward-char 2)))) (defun vi-home-window-line (arg) diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el index 4a9b8fff264..37defd1c5a4 100644 --- a/lisp/obsolete/vip.el +++ b/lisp/obsolete/vip.el @@ -80,7 +80,7 @@ (defvar vip-current-major-mode nil "vip-current-major-mode is the major-mode vi considers it is now. -\(buffer specific\)") +\(buffer specific)") (make-variable-buffer-local 'vip-current-major-mode) @@ -1510,7 +1510,7 @@ used. This behavior is controlled by the sign of prefix numeric value." (* (/ (point-max) 100) arg) (/ (* (point-max) arg) 100))) (back-to-indentation)) - (cond ((looking-at "[\(\[{]") + (cond ((looking-at "[([{]") (if com (move-marker vip-com-point (point))) (forward-sexp 1) (if com @@ -1719,7 +1719,7 @@ STRING. Search will be forward if FORWARD, otherwise backward." (let (buffer) (setq buffer (read-buffer - (format "switch to buffer \(%s\): " + (format "switch to buffer (%s): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer buffer) (vip-change-mode-to-vi))) @@ -1730,7 +1730,7 @@ STRING. Search will be forward if FORWARD, otherwise backward." (let (buffer) (setq buffer (read-buffer - (format "Switch to buffer \(%s\): " + (format "Switch to buffer (%s): " (buffer-name (other-buffer (current-buffer)))))) (switch-to-buffer-other-window buffer) (vip-change-mode-to-vi))) @@ -1741,7 +1741,7 @@ STRING. Search will be forward if FORWARD, otherwise backward." (let (buffer buffer-name) (setq buffer-name (read-buffer - (format "Kill buffer \(%s\): " + (format "Kill buffer (%s): " (buffer-name (current-buffer))))) (setq buffer (if (null buffer-name) @@ -2162,7 +2162,7 @@ is a command.") (defun vip-get-ex-token () "get an ex-token which is either an address or a command. -a token has type \(command, address, end-mark\) and value." +a token has type \(command, address, end-mark) and value." (with-current-buffer " *ex-working-space*" (skip-chars-forward " \t") (cond ((looking-at "[k#]") @@ -2668,7 +2668,7 @@ a token has type \(command, address, end-mark\) and value." "ex-edit" (vip-get-ex-file) (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) - (error "No write since last change \(:e! overrides\)")) + (error "No write since last change (:e! overrides)")) (vip-change-mode-to-emacs) (set-buffer (find-file-noselect (concat default-directory ex-file))) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 651561a2018..a5ad97a468b 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -2437,7 +2437,7 @@ INFO may provide the values of these header arguments (in the (when location (save-excursion (goto-char location) - (when (looking-at (concat org-babel-result-regexp ".*$")) + (when (looking-at org-babel-result-regexp) (delete-region (if keep-keyword (line-beginning-position 2) (save-excursion diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index 154465f28e1..149058f05f4 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -106,7 +106,7 @@ its header arguments." (defun org-babel-fortran-ensure-main-wrap (body params) "Wrap body in a \"program ... end program\" block if none exists." - (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) + (if (string-match "^[ \t]*program\\>" (capitalize body)) (let ((vars (org-babel--get-vars params))) (when vars (error "Cannot use :vars if `program' statement is present")) body) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index baed23bc9a4..c9e4da598ff 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -845,8 +845,8 @@ E.g. \"%C3%B6\" becomes the german o-Umlaut." (insert link) (insert (make-string (- (skip-chars-backward "\\\\")) ?\\)) - (while (search-backward "\]" nil t) - (when (looking-at-p "\\]\\(?:[][]\\|\\'\\)") + (while (search-backward "]" nil t) + (when (looking-at-p "]\\(?:[][]\\|\\'\\)") (insert (make-string (1+ (- (skip-chars-backward "\\\\"))) ?\\)))) (buffer-string))) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 4f89ea54500..5fe140d00ef 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -1883,7 +1883,7 @@ Nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice (const :tag "Hide none" nil) - (string :tag "Regexp "))) + (regexp :tag "Regexp "))) (defvaralias 'org-agenda-remove-tags-when-in-prefix 'org-agenda-remove-tags) @@ -1980,7 +1980,7 @@ category, you can use: (\"Emacs\" \\='(space . (:width (16))))" :group 'org-agenda-line-format :version "24.1" - :type '(alist :key-type (string :tag "Regexp matching category") + :type '(alist :key-type (regexp :tag "Regexp matching category") :value-type (choice (list :tag "Icon" (string :tag "File or data") (symbol :tag "Type") @@ -8981,7 +8981,6 @@ fold drawers." (narrow-to-region (org-entry-beginning-position) (org-entry-end-position)) (org-show-all '(drawers)))) - (when arg ) (setq org-agenda-show-window (selected-window))) (select-window win))) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 003cbef1fdf..ace51270175 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1021,7 +1021,7 @@ Store them in the capture property list." (apply #'encode-time 0 0 org-extend-today-until (cl-cdddr (decode-time prompt-time)))) - ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" + ((string-match "\\([^ ]+\\)-[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) ;; Replace any time range by its start. (apply #'encode-time diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 4b5f9a19e6d..be74dfdbeff 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -4892,7 +4892,7 @@ with `org-element--cache-compare'. This cache is used in A request is a vector with the following pattern: - \[NEXT BEG END OFFSET PARENT PHASE] + [NEXT BEG END OFFSET PARENT PHASE] Processing a synchronization request consists of three phases: diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 0ff0e401d27..55a534d0dcd 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -278,7 +278,7 @@ This should be a single regexp string." :group 'org-protocol :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type 'regexp) ;;; Helper functions: diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 49765472558..98702feb375 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -198,7 +198,7 @@ Other options offered by the customize interface are more restrictive." "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][[:xdigit:].]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") - (string :tag "Regexp:"))) + (regexp :tag "Regexp:"))) (defcustom org-table-number-fraction 0.5 "Fraction of numbers in a column required to make the column align right. @@ -3099,7 +3099,7 @@ function assumes the table is already analyzed (i.e., using (let ((lhs (car e)) (rhs (cdr e))) (cond - ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) + ((string-match-p "\\`@[-+0-9]+\\$-?[0-9]+\\'" lhs) ;; This just refers to one fixed field. (push e res)) ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) diff --git a/lisp/org/org.el b/lisp/org/org.el index 568f5b9b873..52b72817650 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -460,7 +460,7 @@ Matched keyword is in group 1.") org-clock-string) t) "\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*[]>]" "\\|" "<%%([^\r\n>]*>\\)") "Matches a timestamp, possibly preceded by a keyword.") @@ -564,14 +564,14 @@ Effort estimates given in this property need to have the format H:MM.") ;;;; Timestamp -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" +(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)>" "Regular expression for fast time stamp matching.") (defconst org-ts-regexp-inactive - "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]" + "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^\r\n>]*\\)\\]" "Regular expression for fast inactive time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^]\r\n>]*\\)[]>]" "Regular expression for fast time stamp matching.") (defconst org-ts-regexp0 @@ -11410,8 +11410,8 @@ D Show deadlines and scheduled items between a date range." (setq type (or type org-sparse-tree-default-date-type)) (setq org-ts-type type) (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty - \[d]eadlines [b]efore-date [a]fter-date [D]ates range - \[c]ycle through date types: %s" + [d]eadlines [b]efore-date [a]fter-date [D]ates range + [c]ycle through date types: %s" (cl-case type (all "all timestamps") (scheduled "only scheduled") diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index edb3150796f..2f61abad9cc 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -1239,7 +1239,7 @@ calling `org-latex-compile'." :package-version '(Org . "8.3") :type '(repeat (cons - (string :tag "Regexp") + (regexp :tag "Regexp") (string :tag "Message")))) diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 51cb42a49a5..a1486318a7d 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -940,7 +940,7 @@ See `org-odt--build-date-styles' for implementation details." (has-time-p (or (not timestamp) (org-timestamp-has-time-p timestamp))) (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" - "%Y-%m-%dT%H:%M:%S"))) + "%Y-%m-%d"))) (funcall format-timestamp timestamp format end)))) (if iso-date-p iso-date (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index aa99b553244..ba74afce298 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -324,7 +324,7 @@ This value is simply the outline heading level of the current line." (defun gametree-hack-file-layout () (save-excursion (goto-char (point-min)) - (if (looking-at "[^\n]*-*-[^\n]*gametree-local-layout: \\([^;\n]*\\);") + (if (looking-at "[^\n]*-[^\n]*gametree-local-layout: \\([^;\n]*\\);") (progn (goto-char (match-beginning 1)) (delete-region (point) (match-end 1)) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 75ebc29710c..02af263ec34 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -72,7 +72,7 @@ so that it is considered safe, see `enable-local-variables'.") "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" "Regular expression matching bug references. The second subexpression should match the bug reference (usually a number)." - :type 'string + :type 'regexp :version "24.3" ; previously defconst :group 'bug-reference) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index fd61e3e3287..52e6da6f4ac 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1003,7 +1003,7 @@ std\\(err\\|in\\|out\\)\\|user\\)\\)\\>\ ;; Matches an unterminated string/regexp, NOT including the eol at the end. (defconst c-awk-harmless-pattern-characters* - (concat "\\([^{;#/\"\\\\\n\r]\\|" c-awk-esc-pair-re "\\)*")) + (concat "\\([^{;#/\"\\\n\r]\\|" c-awk-esc-pair-re "\\)*")) ;; Matches any "harmless" character in a pattern or an escaped character pair. (defun c-awk-at-statement-end-p () diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 1071191775b..a60812230b8 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -512,11 +512,11 @@ function to control that." (let ((src (default-value 'post-self-insert-hook))) (while src (unless (memq (car src) c--unsafe-post-self-insert-hook-functions) - (add-hook 'dest (car src) t)) ; Preserve the order of the functions. + (push (car src) dest)) (setq src (cdr src))))) - (t (add-hook 'dest (car src) t))) ; Preserve the order of the functions. + (t (push (car src) dest))) (setq src (cdr src))) - (run-hooks 'dest))) + (mapc #'funcall (nreverse dest)))) ; Preserve the order of the functions. (defmacro c--call-post-self-insert-hook-more-safely () ;; Call post-self-insert-hook, if such exists. See comment for @@ -2024,6 +2024,23 @@ other top level construct with a brace block." (c-backward-syntactic-ws) (point)))) + ((and (c-major-mode-is 'objc-mode) (looking-at "[-+]\\s-*(")) ; Objective-C method + ;; Move to the beginning of the method name. + (c-forward-token-2 2 t) + (let* ((class + (save-excursion + (when (re-search-backward + "^\\s-*@\\(implementation\\|class\\|interface\\)\\s-+\\(\\sw+\\)" nil t) + (match-string-no-properties 2)))) + (limit (save-excursion (re-search-forward "[;{]" nil t))) + (method (when (re-search-forward "\\(\\sw+:?\\)" limit t) + (match-string-no-properties 1)))) + (when (and class method) + ;; Add the parameter labels onto name. They always end in ':'. + (while (re-search-forward "\\(\\sw+:\\)" limit 1) + (setq method (concat method (match-string-no-properties 1)))) + (concat "[" class " " method "]")))) + (t ; Normal function or initializer. (when (looking-at c-defun-type-name-decl-key) ; struct, etc. (goto-char (match-end 0)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 7496684d939..9c62b2bb065 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -2671,7 +2671,7 @@ Key bindings: ;; since it's practically impossible to write a regexp that reliably ;; matches such a construct. Other tools are necessary. (defconst c-Java-defun-prompt-regexp - "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*[][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") + "^[ \t]*\\(\\(\\(public\\|protected\\|private\\|const\\|abstract\\|synchronized\\|final\\|static\\|threadsafe\\|transient\\|native\\|volatile\\)\\s-+\\)*\\(\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]+\\|[[a-zA-Z]\\)\\s-*\\)\\s-+\\)\\)?\\(\\([[a-zA-Z][][_$.a-zA-Z0-9]*\\s-+\\)\\s-*\\)?\\([_a-zA-Z][^][ \t:;.,{}()\^?=]*\\|\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)\\)\\s-*\\(([^);{}]*)\\)?\\([] \t]*\\)\\(\\s-*\\<throws\\>\\s-*\\(\\([_$a-zA-Z][_$.a-zA-Z0-9]*\\)[, \t\n\r\f\v]*\\)+\\)?\\s-*") (easy-menu-define c-java-menu java-mode-map "Java Mode Commands" (cons "Java" (c-lang-const c-mode-menu java))) diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 9ddb2ab2bbb..18df372f2c6 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -1322,7 +1322,7 @@ Use it by enabling `eldoc-mode'." (set (make-local-variable 'parens-require-spaces) nil) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) - "\\(\\(?:^\\|[^\\\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") + "\\(\\(?:^\\|[^\\\n]\\)\\(?:\\\\\\\\\\)*\\)#+[ \t]*") ;; Like Lisp mode. Without this, we lose with, say, ;; `backward-up-list' when there's an unbalanced quote in a ;; preceding comment. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5fee2df5863..6f6da8e6b2e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1306,7 +1306,7 @@ the last)." cperl-maybe-white-and-comment-rex ; whitespace-comments "\\(\\sw\\|_\\)+" ; attr-name ;; attr-arg (1 level of internal parens allowed!) - "\\((\\(\\\\.\\|[^\\\\()]\\|([^\\\\()]*)\\)*)\\)?" + "\\((\\(\\\\.\\|[^\\()]\\|([^\\()]*)\\)*)\\)?" "\\(" ; optional : (XXX allows trailing???) cperl-maybe-white-and-comment-rex ; whitespace-comments ":\\)?" @@ -5659,16 +5659,16 @@ indentation and initial hashes. Behaves usually outside of comment." '("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$" 1 font-lock-function-name-face) (cond ((featurep 'font-lock-extra) - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) (0 '(restart 2 t)))) ; To highlight $a{bc}{ef} (font-lock-anchored - '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" (2 font-lock-string-face t) ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" nil nil (1 font-lock-string-face t)))) - (t '("\\([]}\\\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" + (t '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}" 2 font-lock-string-face t))) '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1 font-lock-string-face t) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index dfb987bf99a..6cd2fa3ec05 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -168,6 +168,8 @@ deactivated." :tag "Load Hook" :group 'cwarn :type 'hook) +(make-obsolete-variable 'cwarn-load-hook + "use `with-eval-after-load' instead." "28.1") ;;}}} ;;{{{ The modes diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index dc6bd44e482..bf9b0e961ba 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -474,11 +474,10 @@ (aset ebnf-abn-token-table ?\; 'comment))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-abn-non-terminal-chars - (ebnf-range-regexp "-_0-9A-Za-z" ?\240 ?\377)) + "-_0-9A-Za-z\u00a0-\u00ff") (defconst ebnf-abn-non-terminal-letter-chars - (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + "A-Za-z\u00a0-\u00ff") (defun ebnf-abn-lex () @@ -572,9 +571,8 @@ See documentation for variable `ebnf-abn-lex'." (not eor-p))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-abn-comment-chars - (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237)) + "^\n\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-abn-skip-comment () @@ -612,9 +610,8 @@ See documentation for variable `ebnf-abn-lex'." (ebnf-buffer-substring ebnf-abn-comment-chars)) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-abn-string-chars - (ebnf-range-regexp " -!#-~" ?\240 ?\377)) + " !#-~\u00a0-\u00ff") (defun ebnf-abn-string () diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 583740d3617..4e11862c1dc 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -419,9 +419,8 @@ (aset ebnf-bnf-token-table ebnf-lex-eop-char 'period))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-bnf-non-terminal-chars - (ebnf-range-regexp "!#%&'*-,0-:<>@-Z\\\\^-z~" ?\240 ?\377)) + "!#%&'*-,0-:<>@-Z\\\\^-z~\u00a0-\u00ff") (defun ebnf-bnf-lex () @@ -520,9 +519,8 @@ See documentation for variable `ebnf-bnf-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-bnf-comment-chars - (ebnf-range-regexp "^\n\000-\010\016-\037" ?\177 ?\237)) + "^\n\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-bnf-skip-comment () diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 7e824e487aa..bdebf0db2c1 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -1108,9 +1108,8 @@ (aset ebnf-dtd-token-table ?\] 'end-subset))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-dtd-name-chars - (ebnf-range-regexp "-._:0-9A-Za-z" ?\240 ?\377)) + "-._:0-9A-Za-z\u00a0-\u00ff") (defconst ebnf-dtd-decl-alist @@ -1263,11 +1262,10 @@ See documentation for variable `ebnf-dtd-lex'." (format "%s%s;" start char))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-dtd-double-string-chars - (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) + "\t -!#-~\u00a0-\u00ff") (defconst ebnf-dtd-single-string-chars - (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) + "\t -&(-~\u00a0-\u00ff") (defun ebnf-dtd-string (delim) @@ -1287,11 +1285,10 @@ See documentation for variable `ebnf-dtd-lex'." (forward-char))))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-dtd-comment-chars - (ebnf-range-regexp "^-\000-\010\013\014\016-\037" ?\177 ?\237)) + "^-\000-\010\013\014\016-\037\177\u0080-\u009f") (defconst ebnf-dtd-filename-chars - (ebnf-range-regexp "^-\000-\037" ?\177 ?\237)) + "^-\000-\037\177\u0080-\u009f") (defun ebnf-dtd-skip-comment () diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 2ae6fb67569..20e2d4ca31c 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -405,11 +405,10 @@ (aset ebnf-ebx-token-table ?/ 'comment))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-non-terminal-chars - (ebnf-range-regexp "-_A-Za-z" ?\240 ?\377)) + "-_A-Za-z\u00a0-\u00ff") (defconst ebnf-ebx-non-terminal-letter-chars - (ebnf-range-regexp "A-Za-z" ?\240 ?\377)) + "A-Za-z\u00a0-\u00ff") (defun ebnf-ebx-lex () @@ -488,9 +487,8 @@ See documentation for variable `ebnf-ebx-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-constraint-chars - (ebnf-range-regexp "^\000-\010\016-\037]" ?\177 ?\237)) + "^\000-\010\016-\037]\177\u0080-\u009f") (defun ebnf-ebx-skip-constraint () @@ -517,11 +515,10 @@ See documentation for variable `ebnf-ebx-lex'." (not eor-p))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-ebx-comment-chars - (ebnf-range-regexp "^\000-\010\016-\037\\*" ?\177 ?\237)) + "^\000-\010\016-\037*\177\u0080-\u009f") (defconst ebnf-ebx-filename-chars - (ebnf-range-regexp "^\000-\037\\*" ?\177 ?\237)) + "^\000-\037*\177\u0080-\u009f") (defun ebnf-ebx-skip-comment () @@ -581,11 +578,10 @@ See documentation for variable `ebnf-ebx-lex'." (concat fname (make-string nchar ?*))))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-ebx-double-string-chars - (ebnf-range-regexp "\t -!#-~" ?\240 ?\377)) + "\t -!#-~\u00a0-\u00ff") (defconst ebnf-ebx-single-string-chars - (ebnf-range-regexp "\t -&(-~" ?\240 ?\377)) + "\t -&(-~\u00a0-\u00ff") (defun ebnf-ebx-string (delim) diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index b52094a5912..466e7785053 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -379,9 +379,8 @@ (aset ebnf-iso-token-table ?. 'character))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). (defconst ebnf-iso-non-terminal-chars - (ebnf-range-regexp " 0-9A-Za-z_" ?\240 ?\377)) + " 0-9A-Za-z_\u00a0-\u00ff") (defun ebnf-iso-lex () @@ -487,9 +486,8 @@ See documentation for variable `ebnf-iso-lex'." )))) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-iso-comment-chars - (ebnf-range-regexp "^*(\000-\010\016-\037" ?\177 ?\237)) + "^*(\000-\010\016-\037\177\u0080-\u009f") (defun ebnf-iso-skip-comment () diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index f5d633e8460..a657c637f82 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -397,9 +397,8 @@ See documentation for variable `ebnf-yac-lex'." (< (point) ebnf-limit)) -;; replace the range "\177-\377" (see `ebnf-range-regexp'). (defconst ebnf-yac-skip-chars - (ebnf-range-regexp "^{}/'\"\000-\010\013\016-\037" ?\177 ?\377)) + "^{}/'\"\000-\010\013\016-\037\177\u0080-\u009f") (defun ebnf-yac-skip-code () @@ -442,9 +441,8 @@ See documentation for variable `ebnf-yac-lex'." )) -;; replace the range "\177-\237" (see `ebnf-range-regexp'). (defconst ebnf-yac-comment-chars - (ebnf-range-regexp "^*\000-\010\013\016-\037" ?\177 ?\237)) + "^*\000-\010\013\016-\037\177\u0080-\u009f") (defun ebnf-yac-skip-comment () diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index d5820bbfe0a..f7ac9d36032 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -1157,21 +1157,6 @@ Please send all bug fixes and enhancements to (and (string< ps-print-version "5.2.3") (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) - -;; to avoid gripes with Emacs 20 -(or (fboundp 'assq-delete-all) - (defun assq-delete-all (key alist) - "Delete from ALIST all elements whose car is KEY. -Return the modified alist. -Elements of ALIST that are not conses are ignored." - (let ((tail alist)) - (while tail - (if (and (consp (car tail)) - (eq (car (car tail)) key)) - (setq alist (delq (car tail) alist))) - (setq tail (cdr tail))) - alist))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Variables: @@ -2053,8 +2038,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)." ;; Printing color requires x-color-values. -(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs - (fboundp 'color-instance-rgb-components)) ; XEmacs +(defcustom ebnf-color-p t "Non-nil means use color." :type 'boolean :version "20" @@ -2738,8 +2722,7 @@ Used in functions `ebnf-reset-style', `ebnf-push-style' and (ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold)) (ebnf-eps-footer . nil) (ebnf-entry-percentage . 0.5) - (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs - (fboundp 'color-instance-rgb-components))) ; XEmacs + (ebnf-color-p . t) (ebnf-line-width . 1.0) (ebnf-line-color . "Black") (ebnf-debug-ps . nil) @@ -4979,18 +4962,6 @@ killed after process termination." (kill-buffer (current-buffer)))) -;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward' -;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or -;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or -;; from \177 to \237). It seems that version 20.7 has the same problem. -(defun ebnf-range-regexp (prefix from to) - (let (str) - (while (<= from to) - (setq str (concat str (char-to-string from)) - from (1+ from))) - (concat prefix str))) - - (defvar ebnf-map-name (let ((map (make-vector 256 ?\_))) (mapc #'(lambda (char) @@ -5987,8 +5958,7 @@ killed after process termination." (point)))) -;; replace the range "\240-\377" (see `ebnf-range-regexp'). -(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377)) +(defconst ebnf-8-bit-chars "\u00a0-\u00ff") (defun ebnf-string (chars eos-char kind) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index 811951eaaaf..abc860b9478 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -429,7 +429,7 @@ The only difference is, it returns t in a case when the default returns nil." fortran-font-lock-keywords-1 ;; All type specifiers plus their declared items. (list - (list (concat fortran-type-types "[ \t(/]*\\(*\\)?") + (list (concat fortran-type-types "[ \t(/]*\\(\\*\\)?") ;; Type specifier. '(1 font-lock-type-face) ;; Declaration item (or just /.../ block name). diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index e785acd2840..da5a2a503a6 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -105,13 +105,24 @@ (defvar speedbar-initial-expansion-list-name) (defvar speedbar-frame) -(defvar gdb-memory-address "main") -(defvar gdb-memory-last-address nil +(defvar-local gdb-memory-address-expression "main" + "This expression is passed to gdb. +Possible value: main, $rsp, x+3.") +(defvar-local gdb-memory-address nil + "Address of memory display.") +(defvar-local gdb-memory-last-address nil "Last successfully accessed memory address.") (defvar gdb-memory-next-page nil "Address of next memory page for program memory buffer.") (defvar gdb-memory-prev-page nil "Address of previous memory page for program memory buffer.") +(defvar-local gdb--memory-display-warning nil + "Display warning on memory header if t. + +When error occurs when retrieving memory, gdb-mi displays the +last successful page. In that case the expression might not +match the memory displayed. We want to let the user be aware of +that, so display a warning exclamation mark in the header line.") (defvar gdb-thread-number nil "Main current thread. @@ -3450,7 +3461,7 @@ line." (def-gdb-trigger-and-handler gdb-invalidate-memory (format "-data-read-memory %s %s %d %d %d" - gdb-memory-address + (gdb-mi-quote gdb-memory-address-expression) gdb-memory-format gdb-memory-unit gdb-memory-rows @@ -3490,6 +3501,9 @@ in `gdb-memory-format'." (err-msg (bindat-get-field res 'msg))) (if (not err-msg) (let ((memory (bindat-get-field res 'memory))) + (when gdb-memory-last-address + ;; Nil means last retrieve emits error or just started the session. + (setq gdb--memory-display-warning nil)) (setq gdb-memory-address (bindat-get-field res 'addr)) (setq gdb-memory-next-page (bindat-get-field res 'next-page)) (setq gdb-memory-prev-page (bindat-get-field res 'prev-page)) @@ -3503,10 +3517,15 @@ in `gdb-memory-format'." gdb-memory-format))))) (newline))) ;; Show last page instead of empty buffer when out of bounds - (progn - (let ((gdb-memory-address gdb-memory-last-address)) + (when gdb-memory-last-address + (let ((gdb-memory-address-expression gdb-memory-last-address)) + ;; If we don't set `gdb-memory-last-address' to nil, + ;; `gdb-invalidate-memory' eventually calls + ;; `gdb-read-memory-custom', making an infinite loop. + (setq gdb-memory-last-address nil + gdb--memory-display-warning t) (gdb-invalidate-memory 'update) - (error err-msg)))))) + (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg)))))) (defvar gdb-memory-mode-map (let ((map (make-sparse-keymap))) @@ -3540,7 +3559,7 @@ in `gdb-memory-format'." "Set the start memory address." (interactive) (let ((arg (read-from-minibuffer "Memory address: "))) - (setq gdb-memory-address arg)) + (setq gdb-memory-address-expression arg)) (gdb-invalidate-memory 'update)) (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc) @@ -3723,7 +3742,19 @@ DOC is an optional documentation string." (defvar gdb-memory-header '(:eval (concat - "Start address[" + "Start address " + ;; If `gdb-memory-address-expression' is nil, `propertize' would error. + (propertize (or gdb-memory-address-expression "N/A") + 'face font-lock-warning-face + 'help-echo "mouse-1: set start address" + 'mouse-face 'mode-line-highlight + 'local-map (gdb-make-header-line-mouse-map + 'mouse-1 + #'gdb-memory-set-address-event)) + (if gdb--memory-display-warning + (propertize " !" 'face '(:inherit error :weight bold)) + "") + " [" (propertize "-" 'face font-lock-warning-face 'help-echo "mouse-1: decrement address" @@ -3740,13 +3771,9 @@ DOC is an optional documentation string." 'mouse-1 #'gdb-memory-show-next-page)) "]: " - (propertize gdb-memory-address - 'face font-lock-warning-face - 'help-echo "mouse-1: set start address" - 'mouse-face 'mode-line-highlight - 'local-map (gdb-make-header-line-mouse-map - 'mouse-1 - #'gdb-memory-set-address-event)) + ;; If `gdb-memory-address' is nil, `propertize' would error. + (propertize (or gdb-memory-address "N/A") + 'face font-lock-warning-face) " Rows: " (propertize (number-to-string gdb-memory-rows) 'face font-lock-warning-face diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d4aca28bd7c..7731be59659 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -64,8 +64,7 @@ SYMBOL should be one of `grep-command', `grep-template', "Number of lines in a grep window. If nil, use `compilation-window-height'." :type '(choice (const :tag "Default" nil) integer) - :version "22.1" - :group 'grep) + :version "22.1") (defcustom grep-highlight-matches 'auto-detect "Use special markers to highlight grep matches. @@ -98,9 +97,8 @@ To change the default value, use \\[customize] or call the function (const :tag "Use --color=always" always) (const :tag "Use --color" auto) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-scroll-output nil "Non-nil to scroll the *grep* buffer window as output appears. @@ -109,8 +107,7 @@ Setting it causes the grep commands to put point at the end of their output window so that the end of the output is always visible rather than the beginning." :type 'boolean - :version "22.1" - :group 'grep) + :version "22.1") ;;;###autoload (defcustom grep-command nil @@ -124,8 +121,7 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-template nil "The default command to run for \\[lgrep]. @@ -141,9 +137,8 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-use-null-device 'auto-detect "If t, append the value of `null-device' to `grep' commands. @@ -157,8 +152,7 @@ by `grep-compute-defaults'; to change the default value, use :type '(choice (const :tag "Do Not Append Null Device" nil) (const :tag "Append Null Device" t) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-use-null-filename-separator 'auto-detect "If non-nil, use `grep's `--null' option. @@ -167,8 +161,7 @@ This is done to disambiguate file names in `grep's output." :type '(choice (const :tag "Do Not Use `--null'" nil) (const :tag "Use `--null'" t) (other :tag "Not Set" auto-detect)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) ;;;###autoload (defcustom grep-find-command nil @@ -178,8 +171,7 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :group 'grep) + :set #'grep-apply-setting) (defcustom grep-find-template nil "The default command to run for \\[rgrep]. @@ -194,9 +186,8 @@ by `grep-compute-defaults'; to change the default value, use \\[customize] or call the function `grep-apply-setting'." :type '(choice string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "22.1" - :group 'grep) + :set #'grep-apply-setting + :version "22.1") (defcustom grep-files-aliases '(("all" . "* .[!.]* ..?*") ;; Don't match `..'. See bug#22577 @@ -213,8 +204,7 @@ by `grep-compute-defaults'; to change the default value, use ("texi" . "*.texi") ("asm" . "*.[sS]")) "Alist of aliases for the FILES argument to `lgrep' and `rgrep'." - :type 'alist - :group 'grep) + :type 'alist) (defcustom grep-find-ignored-directories vc-directory-exclusion-list "List of names of sub-directories which `rgrep' shall not recurse into. @@ -223,8 +213,7 @@ to determine whether cdr should not be recursed into. The default value is inherited from `vc-directory-exclusion-list'." :type '(choice (repeat :tag "Ignored directories" string) - (const :tag "No ignored directories" nil)) - :group 'grep) + (const :tag "No ignored directories" nil))) (defcustom grep-find-ignored-files (cons ".#*" (delq nil (mapcar (lambda (s) @@ -235,8 +224,7 @@ The default value is inherited from `vc-directory-exclusion-list'." If an element is a cons cell, the car is called on the search directory to determine whether cdr should not be excluded." :type '(choice (repeat :tag "Ignored file" string) - (const :tag "No ignored files" nil)) - :group 'grep) + (const :tag "No ignored files" nil))) (defcustom grep-save-buffers 'ask "If non-nil, save buffers before running the grep commands. @@ -251,22 +239,19 @@ to limit saving to files located under `my-grep-root'." (const :tag "Ask before saving" ask) (const :tag "Don't save buffers" nil) function - (other :tag "Save all buffers" t)) - :group 'grep) + (other :tag "Save all buffers" t))) (defcustom grep-error-screen-columns nil "If non-nil, column numbers in grep hits are screen columns. See `compilation-error-screen-columns'." :type '(choice (const :tag "Default" nil) integer) - :version "22.1" - :group 'grep) + :version "22.1") ;;;###autoload (defcustom grep-setup-hook nil "List of hook functions run by `grep-process-setup' (see `run-hooks')." - :type 'hook - :group 'grep) + :type 'hook) (defvar grep-mode-map (let ((map (make-sparse-keymap))) @@ -333,7 +318,10 @@ See `compilation-error-screen-columns'." ;; When bootstrapping, tool-bar-map is not properly initialized yet, ;; so don't do anything. (when (keymapp (butlast tool-bar-map)) + ;; We have to `copy-keymap' rather than use keymap inheritance because + ;; we want to put the new items at the *end* of the tool-bar. (let ((map (butlast (copy-keymap tool-bar-map))) + ;; FIXME: Nowadays the last button is not "help" but "search"! (help (last tool-bar-map))) ;; Keep Help last in tool bar (tool-bar-local-item "left-arrow" 'previous-error-no-select 'previous-error-no-select map @@ -439,15 +427,13 @@ and reveals the entire command line. The visibility of the abbreviated part can also be toggled with `grep-find-toggle-abbreviation'." :type 'boolean - :version "27.1" - :group 'grep) + :version "27.1") (defcustom grep-search-path '(nil) "List of directories to search for files named in grep messages. Elements should be directory names, not file names of directories. The value nil as an element means the grep messages buffer `default-directory'." - :group 'grep :version "27.1" :type '(repeat (choice (const :tag "Default" nil) (string :tag "Directory")))) @@ -528,9 +514,8 @@ This variable's value takes effect when `grep-compute-defaults' is called." (const :tag "find -print0 | sort -z | xargs -0'" gnu-sort) string (const :tag "Not Set" nil)) - :set 'grep-apply-setting - :version "27.1" - :group 'grep) + :set #'grep-apply-setting + :version "27.1") ;; History of grep commands. ;;;###autoload @@ -562,7 +547,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:sl=:cx=:ne")) (setq-local grep-num-matches-found 0) (set (make-local-variable 'compilation-exit-message-function) - 'grep-exit-message) + #'grep-exit-message) (run-hooks 'grep-setup-hook)) (defun grep-exit-message (status code msg) @@ -612,7 +597,7 @@ This function is called from `compilation-filter-hook'." (defun grep-probe (command args &optional func result) (let (process-file-side-effects) (equal (condition-case nil - (apply (or func 'process-file) command args) + (apply (or func #'process-file) command args) (error nil)) (or result 0)))) @@ -808,7 +793,7 @@ The value depends on `grep-command', `grep-template', (buffer-substring-no-properties (point) (mark))) (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - 'find-tag-default)) + #'find-tag-default)) "")) (defun grep-default-command () @@ -863,11 +848,11 @@ The value depends on `grep-command', `grep-template', (set (make-local-variable 'compilation-directory-matcher) (list regexp-unmatchable)) (set (make-local-variable 'compilation-process-setup-function) - 'grep-process-setup) + #'grep-process-setup) (set (make-local-variable 'compilation-disable-input) t) (set (make-local-variable 'compilation-error-screen-columns) grep-error-screen-columns) - (add-hook 'compilation-filter-hook 'grep-filter nil t)) + (add-hook 'compilation-filter-hook #'grep-filter nil t)) (defun grep--save-buffers () (when grep-save-buffers @@ -914,7 +899,7 @@ list is empty)." (compilation-start (if (and grep-use-null-device null-device) (concat command-args " " null-device) command-args) - 'grep-mode)) + #'grep-mode)) ;;;###autoload @@ -993,23 +978,31 @@ these include `opts', `dir', `files', `null-device', `excl' and "Read regexp arg for interactive grep using `read-regexp'." (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history)) +(defvar grep-read-files-function #'grep-read-files--default) + +(defun grep-read-files--default () + ;; Instead of a `grep-read-files-function' variable, we used to lookup + ;; mode-specific functions in the major mode's symbol properties, so preserve + ;; this behavior for backward compatibility. + (let ((old-function (get major-mode 'grep-read-files))) ;Obsolete since 28.1 + (if old-function + (funcall old-function) + (let ((file-name-at-point + (run-hook-with-args-until-success 'file-name-at-point-functions))) + (or (if (and (stringp file-name-at-point) + (not (file-directory-p file-name-at-point))) + file-name-at-point) + (buffer-file-name) + (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))))) + (defun grep-read-files (regexp) "Read a file-name pattern arg for interactive grep. -The pattern can include shell wildcards. As whitespace triggers +The pattern can include shell wildcards. As SPC can triggers completion when entering a pattern, including it requires quoting, e.g. `\\[quoted-insert]<space>'. REGEXP is used as a string in the prompt." - (let* ((grep-read-files-function (get major-mode 'grep-read-files)) - (file-name-at-point - (run-hook-with-args-until-success 'file-name-at-point-functions)) - (bn (if grep-read-files-function - (funcall grep-read-files-function) - (or (if (and (stringp file-name-at-point) - (not (file-directory-p file-name-at-point))) - file-name-at-point) - (buffer-file-name) - (replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))) + (let* ((bn (funcall grep-read-files-function)) (fn (and bn (stringp bn) (file-name-nondirectory bn))) @@ -1022,7 +1015,7 @@ REGEXP is used as a string in the prompt." (setq alias (car aliases) aliases (cdr aliases)) (if (string-match (mapconcat - 'wildcard-to-regexp + #'wildcard-to-regexp (split-string (cdr alias) nil t) "\\|") fn) @@ -1043,11 +1036,11 @@ REGEXP is used as a string in the prompt." "\" in files matching wildcard" (if default (concat " (default " default ")")) ": ") - 'read-file-name-internal + #'read-file-name-internal nil nil nil 'grep-files-history (delete-dups (delq nil (append (list default default-alias default-extension) - (mapcar 'car grep-files-aliases))))))) + (mapcar #'car grep-files-aliases))))))) (and files (or (cdr (assoc files grep-files-aliases)) files)))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d5fd1dce6f5..567f452b935 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -486,9 +486,8 @@ The value t means that there is no stack, and we are in display-file mode.") "Additional menu items to add to the speedbar frame.") ;; Make sure our special speedbar mode is loaded -(if (featurep 'speedbar) - (gud-install-speedbar-variables) - (add-hook 'speedbar-load-hook 'gud-install-speedbar-variables)) +(with-eval-after-load 'speedbar + (gud-install-speedbar-variables)) (defun gud-expansion-speedbar-buttons (_directory _zero) "Wrapper for call to `speedbar-add-expansion-list'. diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 10416ead603..0b1ba80edcb 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -162,7 +162,7 @@ This behavior is generally undesirable. If this option is non-nil, the outermos "\\.h\\(h\\|xx\\|pp\\|\\+\\+\\)?\\'" "C/C++ header file name patterns to determine if current buffer is a header. Effective only if `hide-ifdef-expand-reinclusion-protection' is t." - :type 'string + :type 'regexp :version "25.1") (defvar hide-ifdef-mode-submap diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 69385d7060f..d3a2308e06b 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -182,14 +182,14 @@ definition is displayed instead." which specifies the `name' section. Can be used for localization support." :group 'idlwave-online-help - :type 'string) + :type 'regexp) (defcustom idlwave-help-doclib-keyword "KEYWORD" "A regexp for the heading word to search for in doclib headers which specifies the `keywords' section. Can be used for localization support." :group 'idlwave-online-help - :type 'string) + :type 'regexp) (defface idlwave-help-link '((t :inherit link)) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index dba70cb2821..6770fbe8abc 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -1598,7 +1598,7 @@ number.") "A regular expression to match any IDL error.") (defvar idlwave-shell-halting-error - "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+\\s-*.*\\)\n" + "^% .*\n\\([^%].*\n\\)*% Execution halted at:\\(\\s-*\\S-+\\s-*[0-9]+.*\\)\n" "A regular expression to match errors which halt execution.") (defvar idlwave-shell-cant-continue-error diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 2601c2e1653..3092d4c45b0 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -314,7 +314,7 @@ split then a terminal beep and warning are issued." expression will not be changed. Note that the indentation of a comment at the beginning of a line is never changed." :group 'idlwave-code-formatting - :type 'string) + :type 'regexp) (defcustom idlwave-begin-line-comment nil "A comment anchored at the beginning of line. @@ -1096,6 +1096,8 @@ class-arrows Object Arrows with class property" "Normal hook. Executed when idlwave.el is loaded." :group 'idlwave-misc :type 'hook) +(make-obsolete-variable 'idlwave-load-hook + "use `with-eval-after-load' instead." "28.1") (defvar idlwave-experimental nil "Non-nil means turn on a few experimental features. @@ -1870,7 +1872,6 @@ The main features of this mode are 8. Hooks ----- - Loading idlwave.el runs `idlwave-load-hook'. Turning on `idlwave-mode' runs `idlwave-mode-hook'. 9. Documentation and Customization diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index a24b94073fc..9f34a377f4a 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -130,9 +130,8 @@ mode. Default is whitespace followed by 0 or 1 single-letter colon-keyword ;;; "This function binds many inferior-lisp commands to C-c <letter> bindings, ;;;where they are more accessible. C-c <letter> bindings are reserved for the -;;;user, so these bindings are non-standard. If you want them, you should -;;;have this function called by the inferior-lisp-load-hook: -;;; (add-hook 'inferior-lisp-load-hook 'inferior-lisp-install-letter-bindings) +;;;user, so these bindings are non-standard. If you want them: +;;; (with-eval-after-load 'inf-lisp 'inferior-lisp-install-letter-bindings) ;;;You can modify this function to install just the bindings you want." (defun inferior-lisp-install-letter-bindings () (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go) @@ -632,6 +631,8 @@ See variable `lisp-describe-sym-command'." ;;;=============================== (defvar inferior-lisp-load-hook nil "This hook is run when the library `inf-lisp' is loaded.") +(make-obsolete-variable 'inferior-lisp-load-hook + "use `with-eval-after-load' instead." "28.1") (run-hooks 'inferior-lisp-load-hook) diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 6f0e535def8..4a5d872b790 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -895,6 +895,8 @@ The environment marked is the one that contains point or follows point." "Hook evaluated when first loading Metafont or MetaPost mode." :type 'hook :group 'meta-font) +(make-obsolete-variable 'meta-mode-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom meta-common-mode-hook nil "Hook evaluated by both `metafont-mode' and `metapost-mode'." diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index fcd9294f660..8c060991f42 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -1688,7 +1688,7 @@ comment block. If not in a // comment, just does a normal newline." ;; as comment starters. Fix it here by removing the "2" from the syntax ;; of the second char of such sequences. ("/\\(\\*\\)" (1 ". 3b")) - ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) ;; Pascal uses '' and "" rather than \' and \" to escape quotes. ("''\\|\"\"" (0 (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index 13505d04a2d..5036b793c55 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -187,7 +187,7 @@ ;; as comment starters. Fix it here by removing the "2" from the syntax ;; of the second char of such sequences. ("/\\(\\*\\)" (1 ". 3b")) - ("(\\(\\/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) + ("(\\(/\\)" (1 (prog1 ". 1c" (forward-char -1) nil))) ;; Pascal uses '' and "" rather than \' and \" to escape quotes. ("''\\|\"\"" (0 (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f864f6a34cd..ff0b6a331bc 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -235,7 +235,7 @@ (match-beginning 0)))))) (string-to-syntax ". p")))) ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) + ("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_")) ;; format statements ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 107b29189f5..a2d85d0bef8 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1993,7 +1993,7 @@ position, else returns nil." ;; IPython prompts activated, this adds some safeguard for that. "In : " "\\.\\.\\.: ") "List of regular expressions matching input prompts." - :type '(repeat string) + :type '(repeat regexp) :version "24.4") (defcustom python-shell-prompt-output-regexps @@ -2001,28 +2001,28 @@ position, else returns nil." "Out\\[[0-9]+\\]: " ; IPython "Out :") ; ipdb safeguard "List of regular expressions matching output prompts." - :type '(repeat string) + :type '(repeat regexp) :version "24.4") (defcustom python-shell-prompt-regexp ">>> " "Regular expression matching top level input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-block-regexp "\\.\\.\\.:? " "Regular expression matching block input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-output-regexp "" "Regular expression matching output prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (defcustom python-shell-prompt-pdb-regexp "[(<]*[Ii]?[Pp]db[>)]+ " "Regular expression matching pdb input prompt of Python shell. It should not contain a caret (^) at the beginning." - :type 'string) + :type 'regexp) (define-obsolete-variable-alias 'python-shell-enable-font-lock 'python-shell-font-lock-enable "25.1") @@ -2111,7 +2111,7 @@ virtualenv." "(" (group (1+ digit)) ")" (1+ (not (any "("))) "()") 1 2)) "`compilation-error-regexp-alist' for inferior Python." - :type '(alist string) + :type '(alist regexp) :group 'python) (defmacro python-shell--add-to-path-with-priority (pathvar paths) @@ -3785,7 +3785,7 @@ the top stack frame has been reached. Filename is expected in the first parenthesized expression. Line number is expected in the second parenthesized expression." - :type 'string + :type 'regexp :version "27.1" :safe 'stringp) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 5da5577c108..e16225c7fa9 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -801,7 +801,7 @@ The style of the comment is controlled by `ruby-encoding-magic-comment-style'." (let ((coding-system (ruby--detect-encoding))) (when coding-system (if (looking-at "^#!") (beginning-of-line 2)) - (cond ((looking-at "\\s *#\\s *.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") + (cond ((looking-at "\\s *#.*\\(en\\)?coding\\s *:\\s *\\([-a-z0-9_]*\\)") ;; update existing encoding comment if necessary (unless (string= (match-string 2) coding-system) (goto-char (match-beginning 2)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index cc6d5b46ed2..044d7820ee3 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -64,61 +64,10 @@ ;; * Indent right half sh-basic-offset ;; / Indent left half sh-basic-offset. ;; -;; There are 4 commands to help set the indentation variables: -;; -;; `sh-show-indent' -;; This shows what variable controls the indentation of the current -;; line and its value. -;; -;; `sh-set-indent' -;; This allows you to set the value of the variable controlling the -;; current line's indentation. You can enter a number or one of a -;; number of special symbols to denote the value of sh-basic-offset, -;; or its negative, or half it, or twice it, etc. If you've used -;; cc-mode this should be familiar. If you forget which symbols are -;; valid simply press C-h at the prompt. -;; -;; `sh-learn-line-indent' -;; Simply make the line look the way you want it, then invoke this -;; command. It will set the variable to the value that makes the line -;; indent like that. If called with a prefix argument then it will set -;; the value to one of the symbols if applicable. -;; -;; `sh-learn-buffer-indent' -;; This is the deluxe function! It "learns" the whole buffer (use -;; narrowing if you want it to process only part). It outputs to a -;; buffer *indent* any conflicts it finds, and all the variables it has -;; learned. This buffer is a sort of Occur mode buffer, allowing you to -;; easily find where something was set. It is popped to automatically -;; if there are any conflicts found or if `sh-popup-occur-buffer' is -;; non-nil. -;; `sh-indent-comment' will be set if all comments follow the same -;; pattern; if they don't it will be set to nil. -;; Whether `sh-basic-offset' is set is determined by variable -;; `sh-learn-basic-offset'. -;; -;; Unfortunately, `sh-learn-buffer-indent' can take a long time to run -;; (e.g. if there are large case statements). Perhaps it does not make -;; sense to run it on large buffers: if lots of lines have different -;; indentation styles it will produce a lot of diagnostics in the -;; *indent* buffer; if there is a consistent style then running -;; `sh-learn-buffer-indent' on a small region of the buffer should -;; suffice. -;; ;; Saving indentation values ;; ------------------------- -;; After you've learned the values in a buffer, how to you remember -;; them? Originally I had hoped that `sh-learn-buffer-indent' -;; would make this unnecessary; simply learn the values when you visit -;; the buffer. -;; You can do this automatically like this: -;; (add-hook 'sh-set-shell-hook #'sh-learn-buffer-indent) -;; -;; However... `sh-learn-buffer-indent' is extremely slow, -;; especially on large-ish buffer. Also, if there are conflicts the -;; "last one wins" which may not produce the desired setting. -;; -;; So...There is a minimal way of being able to save indentation values and +;; After you've learned the values in a buffer, how to you remember them? +;; There is a minimal way of being able to save indentation values and ;; to reload them in another buffer or at another point in time. ;; ;; Use `sh-name-style' to give a name to the indentation settings of @@ -132,7 +81,7 @@ ;; Indentation variables - buffer local or global? ;; ---------------------------------------------- ;; I think that often having them buffer-local makes sense, -;; especially if one is using `sh-learn-buffer-indent'. However, if +;; especially if one is using `smie-config-guess'. However, if ;; a user sets values using customization, these changes won't appear ;; to work if the variables are already local! ;; @@ -175,18 +124,10 @@ ;; - Indenting many lines is slow. It currently does each line ;; independently, rather than saving state information. ;; -;; - `sh-learn-buffer-indent' is extremely slow. -;; -;; - "case $x in y) echo ;; esac)" the last ) is mis-identified as being -;; part of a case-pattern. You need to add a semi-colon after "esac" to -;; coerce sh-script into doing the right thing. -;; ;; - "echo $z in ps | head)" the last ) is mis-identified as being part of ;; a case-pattern. You need to put the "in" between quotes to coerce ;; sh-script into doing the right thing. ;; -;; - A line starting with "}>foo" is not indented like "} >foo". -;; ;; Richard Sharman <rsharman@pobox.com> June 1999. ;;; Code: @@ -474,10 +415,10 @@ This is buffer-local in every such buffer.") (define-key map "\C-c\C-i" 'sh-if) (define-key map "\C-c\C-f" 'sh-for) (define-key map "\C-c\C-c" 'sh-case) - (define-key map "\C-c?" 'sh-show-indent) - (define-key map "\C-c=" 'sh-set-indent) - (define-key map "\C-c<" 'sh-learn-line-indent) - (define-key map "\C-c>" 'sh-learn-buffer-indent) + (define-key map "\C-c?" #'smie-config-show-indent) + (define-key map "\C-c=" #'smie-config-set-indent) + (define-key map "\C-c<" #'smie-config-set-indent) + (define-key map "\C-c>" #'smie-config-guess) (define-key map "\C-c\C-\\" 'sh-backslash-region) (define-key map "\C-c+" 'sh-add) @@ -493,17 +434,14 @@ This is buffer-local in every such buffer.") (define-key map [remap backward-sentence] 'sh-beginning-of-command) (define-key map [remap forward-sentence] 'sh-end-of-command) (define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map)) - (define-key menu-map [sh-learn-buffer-indent] - '(menu-item "Learn buffer indentation" sh-learn-buffer-indent + (define-key menu-map [smie-config-guess] + '(menu-item "Learn buffer indentation" smie-config-guess :help "Learn how to indent the buffer the way it currently is.")) - (define-key menu-map [sh-learn-line-indent] - '(menu-item "Learn line indentation" sh-learn-line-indent - :help "Learn how to indent a line as it currently is indented")) - (define-key menu-map [sh-show-indent] - '(menu-item "Show indentation" sh-show-indent + (define-key menu-map [smie-config-show-indent] + '(menu-item "Show indentation" smie-config-show-indent :help "Show the how the current line would be indented")) - (define-key menu-map [sh-set-indent] - '(menu-item "Set indentation" sh-set-indent + (define-key menu-map [smie-config-set-indent] + '(menu-item "Set indentation" smie-config-set-indent :help "Set the indentation for the current line")) (define-key menu-map [sh-pair] @@ -1158,7 +1096,7 @@ subshells can nest." (")" (0 (sh-font-lock-paren (match-beginning 0)))) ;; Highlight (possibly nested) subshells inside "" quoted ;; regions correctly. - ("\"\\(?:\\(?:[^\\\"]\\|\\\\.\\)*?\\)??\\(\\$(\\|`\\)" + ("\"\\(?:[^\\\"]\\|\\\\.\\)*?\\(\\$(\\|`\\)" (1 (ignore (if (nth 8 (save-excursion (syntax-ppss (match-beginning 0)))) (goto-char (1+ (match-beginning 0))) @@ -1196,20 +1134,8 @@ and command `sh-reset-indent-vars-to-global-values'." :options '(sh-electric-here-document-mode) :group 'sh-script) -(defcustom sh-learn-basic-offset nil - "When `sh-guess-basic-offset' should learn `sh-basic-offset'. - -nil mean: never. -t means: only if there seems to be an obvious value. -Anything else means: whenever we have a \"good guess\" as to the value." - :type '(choice - (const :tag "Never" nil) - (const :tag "Only if sure" t) - (const :tag "If have a good guess" usually)) - :group 'sh-indentation) - (defcustom sh-popup-occur-buffer nil - "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. + "Controls when `smie-config-guess' pops the `*indent*' buffer. If t it is always shown. If nil, it is shown only when there are conflicts." :type '(choice @@ -1217,14 +1143,6 @@ are conflicts." (const :tag "Always" t)) :group 'sh-indentation) -(defcustom sh-blink t - "If non-nil, `sh-show-indent' shows the line indentation is relative to. -The position on the line is not necessarily meaningful. -In some cases the line will be the matching keyword, but this is not -always the case." - :type 'boolean - :group 'sh-indentation) - (defcustom sh-first-lines-indent 0 "The indentation of the first non-blank non-comment line. Usually 0 meaning first column. @@ -1567,11 +1485,9 @@ following commands are available, based on the current shell's syntax: \\[sh-while] while loop For sh and rc shells indentation commands are: -\\[sh-show-indent] Show the variable controlling this line's indentation. -\\[sh-set-indent] Set then variable controlling this line's indentation. -\\[sh-learn-line-indent] Change the indentation variable so this line -would indent to the way it currently is. -\\[sh-learn-buffer-indent] Set the indentation variables so the +\\[smie-config-show-indent] Show the rules controlling this line's indentation. +\\[smie-config-set-indent] Change the rules controlling this line's indentation. +\\[smie-config-guess] Try to tweak the indentation rules so the buffer indents as it currently is indented. @@ -1738,13 +1654,6 @@ This adds rules for comments and assignments." (require 'smie) -;; The SMIE code should generally be preferred, but it currently does not obey -;; the various indentation custom-vars, and it misses some important features -;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent, -;; sh-name/save/load-style. -(defvar sh-use-smie t - "Whether to use the SMIE code for navigation and indentation.") - (defun sh-smie--keyword-p () "Non-nil if we're at a keyword position. A keyword position is one where if we're looking at something that looks @@ -2279,60 +2188,6 @@ Point should be before the newline." (defvar sh-regexp-for-done nil "A buffer-local regexp to match opening keyword for done.") -(defvar sh-kw-alist nil - "A buffer-local, since it is shell-type dependent, list of keywords.") - -;; ( key-word first-on-this on-prev-line ) -;; This is used to set `sh-kw-alist' which is a list of sublists each -;; having 3 elements: -;; a keyword -;; a rule to check when the keyword appears on "this" line -;; a rule to check when the keyword appears on "the previous" line -;; The keyword is usually a string and is the first word on a line. -;; If this keyword appears on the line whose indentation is to be -;; calculated, the rule in element 2 is called. If this returns -;; non-zero, the resulting point (which may be changed by the rule) -;; is used as the default indentation. -;; If it returned false or the keyword was not found in the table, -;; then the keyword from the previous line is looked up and the rule -;; in element 3 is called. In this case, however, -;; `sh-get-indent-info' does not stop but may keep going and test -;; other keywords against rules in element 3. This is because the -;; preceding line could have, for example, an opening "if" and an -;; opening "while" keyword and we need to add the indentation offsets -;; for both. -;; -(defconst sh-kw - '((sh - ("if" nil sh-handle-prev-if) - ("elif" sh-handle-this-else sh-handle-prev-else) - ("else" sh-handle-this-else sh-handle-prev-else) - ("fi" sh-handle-this-fi sh-handle-prev-fi) - ("then" sh-handle-this-then sh-handle-prev-then) - ("(" nil sh-handle-prev-open) - ("{" nil sh-handle-prev-open) - ("[" nil sh-handle-prev-open) - ("}" sh-handle-this-close nil) - (")" sh-handle-this-close nil) - ("]" sh-handle-this-close nil) - ("case" nil sh-handle-prev-case) - ("esac" sh-handle-this-esac sh-handle-prev-esac) - (case-label nil sh-handle-after-case-label) ;; ??? - (";;" nil sh-handle-prev-case-alt-end) ;; ??? - (";;&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. - (";&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. - ("done" sh-handle-this-done sh-handle-prev-done) - ("do" sh-handle-this-do sh-handle-prev-do)) - - ;; Note: we don't need specific stuff for bash and zsh shells; - ;; the regexp `sh-regexp-for-done' handles the extra keywords - ;; these shells use. - (rc - ("{" nil sh-handle-prev-open) - ("}" sh-handle-this-close nil) - ("case" sh-handle-this-rc-case sh-handle-prev-rc-case)))) - - (defun sh-set-shell (shell &optional no-query-flag insert-flag) "Set this buffer's shell to SHELL (a string). @@ -2400,16 +2255,6 @@ whose value is the shell name (don't quote it)." (funcall mksym "rules") :forward-token (funcall mksym "forward-token") :backward-token (funcall mksym "backward-token"))) - (unless sh-use-smie - (setq-local sh-kw-alist (sh-feature sh-kw)) - (let ((regexp (sh-feature sh-kws-for-done))) - (if regexp - (setq-local sh-regexp-for-done - (sh-mkword-regexpr (regexp-opt regexp t))))) - (message "setting up indent stuff") - ;; sh-mode has already made indent-line-function local - ;; but do it in case this is called before that. - (setq-local indent-line-function #'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) @@ -2564,11 +2409,6 @@ region, clear header." (eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2))) ;; Indentation stuff. -(defun sh-must-support-indent () - "Signal an error if the shell type for this buffer is not supported. -Also, the buffer must be in Shell-script mode." - (unless sh-indent-supported-here - (error "This buffer's shell does not support indentation through Emacs"))) (defun sh-make-vars-local () "Make the indentation variables local to this buffer. @@ -2589,654 +2429,12 @@ Then, if variable `sh-make-vars-local' is non-nil, make them local." (if sh-make-vars-local (mapcar 'make-local-variable sh-var-list))) - -;; Theoretically these are only needed in shell and derived modes. -;; However, the routines which use them are only called in those modes. -(defconst sh-special-keywords "then\\|do") - -(defun sh-help-string-for-variable (var) - "Construct a string for `sh-read-variable' when changing variable VAR ." - (let ((msg (documentation-property var 'variable-documentation)) - (msg2 "")) - (unless (memq var '(sh-first-lines-indent sh-indent-comment)) - (setq msg2 - (format "\n -You can enter a number (positive to increase indentation, -negative to decrease indentation, zero for no change to indentation). - -Or, you can enter one of the following symbols which are relative to -the value of variable `sh-basic-offset' -which in this buffer is currently %s. - -\t%s." - sh-basic-offset - (mapconcat (lambda (x) - (nth (1- (length x)) x)) - sh-symbol-list "\n\t")))) - (concat - ;; The following shows the global not the local value! - ;; (format "Current value of %s is %s\n\n" var (symbol-value var)) - msg msg2))) - -(defun sh-read-variable (var) - "Read a new value for indentation variable VAR." - (let ((minibuffer-help-form `(sh-help-string-for-variable - (quote ,var))) - val) - (setq val (read-from-minibuffer - (format "New value for %s (press %s for help): " - var (single-key-description help-char)) - (format "%s" (symbol-value var)) - nil t)) - val)) - - - (defun sh-in-comment-or-string (start) "Return non-nil if START is in a comment or string." (save-excursion (let ((state (syntax-ppss start))) (or (nth 3 state) (nth 4 state))))) -(defun sh-goto-matching-if () - "Go to the matching if for a fi. -This handles nested if..fi pairs." - (let ((found (sh-find-prev-matching "\\bif\\b" "\\bfi\\b" 1))) - (if found - (goto-char found)))) - - -;; Functions named sh-handle-this-XXX are called when the keyword on the -;; line whose indentation is being handled contain XXX; -;; those named sh-handle-prev-XXX are when XXX appears on the previous line. - -(defun sh-handle-prev-if () - (list '(+ sh-indent-after-if))) - -(defun sh-handle-this-else () - (if (sh-goto-matching-if) - ;; (list "aligned to if") - (list "aligned to if" '(+ sh-indent-for-else)) - nil - )) - -(defun sh-handle-prev-else () - (if (sh-goto-matching-if) - (list '(+ sh-indent-after-if)) - )) - -(defun sh-handle-this-fi () - (if (sh-goto-matching-if) - (list "aligned to if" '(+ sh-indent-for-fi)) - nil - )) - -(defun sh-handle-prev-fi () - ;; Why do we have this rule? Because we must go back to the if - ;; to get its indent. We may continue back from there. - ;; We return nil because we don't have anything to add to result, - ;; the side affect of setting align-point is all that matters. - ;; we could return a comment (a string) but I can't think of a good one... - (sh-goto-matching-if) - nil) - -(defun sh-handle-this-then () - (let ((p (sh-goto-matching-if))) - (if p - (list '(+ sh-indent-for-then)) - ))) - -(defun sh-handle-prev-then () - (let ((p (sh-goto-matching-if))) - (if p - (list '(+ sh-indent-after-if)) - ))) - -(defun sh-handle-prev-open () - (save-excursion - (let ((x (sh-prev-stmt))) - (if (and x - (progn - (goto-char x) - (or - (looking-at "function\\b") - (looking-at "\\s-*\\S-+\\s-*()") - ))) - (list '(+ sh-indent-after-function)) - (list '(+ sh-indent-after-open))) - ))) - -(defun sh-handle-this-close () - (forward-char 1) ;; move over ")" - (if (sh-safe-forward-sexp -1) - (list "aligned to opening paren"))) - -(defun sh-goto-matching-case () - (let ((found (sh-find-prev-matching "\\bcase\\b" "\\besac\\b" 1))) - (if found (goto-char found)))) - -(defun sh-handle-prev-case () - ;; This is typically called when point is on same line as a case - ;; we shouldn't -- and can't find prev-case - (if (looking-at ".*\\<case\\>") - (list '(+ sh-indent-for-case-label)) - (error "We don't seem to be on a line with a case"))) ;; debug - -(defun sh-handle-this-esac () - (if (sh-goto-matching-case) - (list "aligned to matching case"))) - -(defun sh-handle-prev-esac () - (if (sh-goto-matching-case) - (list "matching case"))) - -(defun sh-handle-after-case-label () - (if (sh-goto-matching-case) - (list '(+ sh-indent-for-case-alt)))) - -(defun sh-handle-prev-case-alt-end () - (if (sh-goto-matching-case) - (list '(+ sh-indent-for-case-label)))) - -(defun sh-safe-forward-sexp (&optional arg) - "Try and do a `forward-sexp', but do not error. -Return new point if successful, nil if an error occurred." - (condition-case nil - (progn - (forward-sexp (or arg 1)) - (point)) ;; return point if successful - (error - (sh-debug "oops!(1) %d" (point)) - nil))) ;; return nil if fail - -(defun sh-goto-match-for-done () - (let ((found (sh-find-prev-matching sh-regexp-for-done sh-re-done 1))) - (if found - (goto-char found)))) - -(defun sh-handle-this-done () - (if (sh-goto-match-for-done) - (list "aligned to do stmt" '(+ sh-indent-for-done)))) - -(defun sh-handle-prev-done () - (if (sh-goto-match-for-done) - (list "previous done"))) - -(defun sh-handle-this-do () - (if (sh-goto-match-for-done) - (list '(+ sh-indent-for-do)))) - -(defun sh-handle-prev-do () - (cond - ((save-restriction - (narrow-to-region (point) (line-beginning-position)) - (sh-goto-match-for-done)) - (sh-debug "match for done found on THIS line") - (list '(+ sh-indent-after-loop-construct))) - ((sh-goto-match-for-done) - (sh-debug "match for done found on PREV line") - (list '(+ sh-indent-after-do))) - (t - (message "match for done NOT found") - nil))) - -;; for rc: -(defun sh-find-prev-switch () - "Find the line for the switch keyword matching this line's case keyword." - (re-search-backward "\\<switch\\>" nil t)) - -(defun sh-handle-this-rc-case () - (if (sh-find-prev-switch) - (list '(+ sh-indent-after-switch)) - ;; (list '(+ sh-indent-for-case-label)) - nil)) - -(defun sh-handle-prev-rc-case () - (list '(+ sh-indent-after-case))) - -(defun sh-check-rule (n thing) - (let ((rule (nth n (assoc thing sh-kw-alist))) - (val nil)) - (if rule - (progn - (setq val (funcall rule)) - (sh-debug "rule (%d) for %s at %d is %s\n-> returned %s" - n thing (point) rule val))) - val)) - - -(defun sh-get-indent-info () - "Return indent-info for this line. -This is a list. nil means the line is to be left as is. -Otherwise it contains one or more of the following sublists: -\(t NUMBER) NUMBER is the base location in the buffer that indentation is - relative to. If present, this is always the first of the - sublists. The indentation of the line in question is - derived from the indentation of this point, possibly - modified by subsequent sublists. -\(+ VAR) -\(- VAR) Get the value of variable VAR and add to or subtract from - the indentation calculated so far. -\(= VAR) Get the value of variable VAR and *replace* the - indentation with its value. This only occurs for - special variables such as `sh-indent-comment'. -STRING This is ignored for the purposes of calculating - indentation, it is printed in certain cases to help show - what the indentation is based on." - ;; See comments before `sh-kw'. - (save-excursion - (let ((have-result nil) - this-kw - val - (result nil) - (align-point nil) - prev-line-end x) - (beginning-of-line) - ;; Note: setting result to t means we are done and will return nil. - ;;(This function never returns just t.) - (cond - ((or (nth 3 (syntax-ppss (point))) - (eq (get-text-property (point) 'face) 'sh-heredoc)) - ;; String continuation -- don't indent - (setq result t) - (setq have-result t)) - ((looking-at "\\s-*#") ; was (equal this-kw "#") - (if (bobp) - (setq result t) ;; return nil if 1st line! - (setq result (list '(= sh-indent-comment))) - ;; we still need to get previous line in case - ;; sh-indent-comment is t (indent as normal) - (setq align-point (sh-prev-line nil)) - (setq have-result nil) - )) - ) ;; cond - - (unless have-result - ;; Continuation lines are handled specially - (if (sh-this-is-a-continuation) - (progn - (setq result - (if (save-excursion - (beginning-of-line) - (not (memq (char-before (- (point) 2)) '(?\s ?\t)))) - ;; By convention, if the continuation \ is not - ;; preceded by a SPC or a TAB it means that the line - ;; is cut at a place where spaces cannot be freely - ;; added/removed. I.e. do not indent the line. - (list '(= nil)) - ;; We assume the line being continued is already - ;; properly indented... - ;; (setq prev-line-end (sh-prev-line)) - (setq align-point (sh-prev-line nil)) - (list '(+ sh-indent-for-continuation)))) - (setq have-result t)) - (beginning-of-line) - (skip-chars-forward " \t") - (setq this-kw (sh-get-kw))) - - ;; Handle "this" keyword: first word on the line we're - ;; calculating indentation info for. - (if this-kw - (if (setq val (sh-check-rule 1 this-kw)) - (progn - (setq align-point (point)) - (sh-debug - "this - setting align-point to %d" align-point) - (setq result (append result val)) - (setq have-result t) - ;; set prev-line to continue processing remainder - ;; of this line as a previous line - (setq prev-line-end (point)) - )))) - - (unless have-result - (setq prev-line-end (sh-prev-line 'end))) - - (if prev-line-end - (save-excursion - ;; We start off at beginning of this line. - ;; Scan previous statements while this is <= - ;; start of previous line. - (goto-char prev-line-end) - (setq x t) - (while (and x (setq x (sh-prev-thing))) - (sh-debug "at %d x is: %s result is: %s" (point) x result) - (cond - ((and (equal x ")") - (equal (get-text-property (1- (point)) 'syntax-table) - sh-st-punc)) - (sh-debug "Case label) here") - (setq x 'case-label) - (if (setq val (sh-check-rule 2 x)) - (progn - (setq result (append result val)) - (setq align-point (point)))) - (or (bobp) - (forward-char -1)) - (skip-chars-forward "*0-9?[]a-z") - ) - ((string-match "[])}]" x) - (setq x (sh-safe-forward-sexp -1)) - (if x - (progn - (setq align-point (point)) - (setq result (append result - (list "aligned to opening paren"))) - ))) - ((string-match "[[({]" x) - (sh-debug "Checking special thing: %s" x) - (if (setq val (sh-check-rule 2 x)) - (setq result (append result val))) - (forward-char -1) - (setq align-point (point))) - ((string-match "[\"'`]" x) - (sh-debug "Skipping back for %s" x) - ;; this was oops-2 - (setq x (sh-safe-forward-sexp -1))) - ((stringp x) - (sh-debug "Checking string %s at %s" x (point)) - (if (setq val (sh-check-rule 2 x)) - ;; (or (eq t (car val)) - ;; (eq t (car (car val)))) - (setq result (append result val))) - ;; not sure about this test Wed Jan 27 23:48:35 1999 - (setq align-point (point)) - (unless (bolp) - (forward-char -1))) - (t - (error "Don't know what to do with %s" x)) - ) - ) ;; while - (sh-debug "result is %s" result) - ) - (sh-debug "No prev line!") - (sh-debug "result: %s align-point: %s" result align-point) - ) - - (if align-point - ;; was: (setq result (append result (list (list t align-point)))) - (setq result (append (list (list t align-point)) result)) - ) - (sh-debug "result is now: %s" result) - - (or result - (setq result (list (if prev-line-end - (list t prev-line-end) - (list '= 'sh-first-lines-indent))))) - - (if (eq result t) - (setq result nil)) - (sh-debug "result is: %s" result) - result - ) ;; let - )) - - -(defun sh-get-indent-var-for-line (&optional info) - "Return the variable controlling indentation for this line. -If there is not [just] one such variable, return a string -indicating the problem. -If INFO is supplied it is used, else it is calculated." - (let ((var nil) - (result nil) - (reason nil) - sym elt) - (or info - (setq info (sh-get-indent-info))) - (if (null info) - (setq result "this line to be left as is") - (while (and info (null result)) - (setq elt (car info)) - (cond - ((stringp elt) - (setq reason elt) - ) - ((not (listp elt)) - (error "sh-get-indent-var-for-line invalid elt: %s" elt)) - ;; so it is a list - ((eq t (car elt)) - ) ;; nothing - ((symbolp (setq sym (nth 1 elt))) - ;; A bit of a kludge - when we see the sh-indent-comment - ;; ignore other variables. Otherwise it is tricky to - ;; "learn" the comment indentation. - (if (eq var 'sh-indent-comment) - (setq result var) - (if var - (setq result - "this line is controlled by more than 1 variable.") - (setq var sym)))) - (t - (error "sh-get-indent-var-for-line invalid list elt: %s" elt))) - (setq info (cdr info)) - )) - (or result - (setq result var)) - (or result - (setq result reason)) - (if (null result) - ;; e.g. just had (t POS) - (setq result "line has default indentation")) - result)) - - - -;; Finding the previous line isn't trivial. -;; We must *always* go back one more and see if that is a continuation -;; line -- it is the PREVIOUS line which is continued, not the one -;; we are going to! -;; Also, we want to treat a whole "here document" as one big line, -;; because we may want to align to the beginning of it. -;; -;; What we do: -;; - go back to previous non-empty line -;; - if this is in a here-document, go to the beginning of it -;; - while previous line is continued, go back one line -(defun sh-prev-line (&optional end) - "Back to end of previous non-comment non-empty line. -Go to beginning of logical line unless END is non-nil, in which case -we go to the end of the previous line and do not check for continuations." - (save-excursion - (beginning-of-line) - (forward-comment (- (point-max))) - (unless end (beginning-of-line)) - (when (and (not (bobp)) - (eq (get-text-property (1- (point)) 'face) 'sh-heredoc)) - (let ((p1 (previous-single-property-change (1- (point)) 'face))) - (when p1 - (goto-char p1) - (if end - (end-of-line) - (beginning-of-line))))) - (unless end - ;; we must check previous lines to see if they are continuation lines - ;; if so, we must return position of first of them - (while (and (sh-this-is-a-continuation) - (>= 0 (forward-line -1)))) - (beginning-of-line) - (skip-chars-forward " \t")) - (point))) - - -(defun sh-prev-stmt () - "Return the address of the previous stmt or nil." - ;; This is used when we are trying to find a matching keyword. - ;; Searching backward for the keyword would certainly be quicker, but - ;; it is hard to remove "false matches" -- such as if the keyword - ;; appears in a string or quote. This way is slower, but (I think) safer. - (interactive) - (save-excursion - (let ((going t) - (start (point)) - (found nil) - (prev nil)) - (skip-chars-backward " \t;|&({[") - (while (and (not found) - (not (bobp)) - going) - ;; Do a backward-sexp if possible, else backup bit by bit... - (if (sh-safe-forward-sexp -1) - (progn - (if (looking-at sh-special-keywords) - (progn - (setq found prev)) - (setq prev (point)) - )) - ;; backward-sexp failed - (if (zerop (skip-chars-backward " \t()[]{};`'")) - (forward-char -1)) - (if (bolp) - (let ((back (sh-prev-line nil))) - (if back - (goto-char back) - (setq going nil))))) - (unless found - (skip-chars-backward " \t") - (if (or (and (bolp) (not (sh-this-is-a-continuation))) - (eq (char-before) ?\;) - (looking-at "\\s-*[|&]")) - (setq found (point))))) - (if found - (goto-char found)) - (if found - (progn - (skip-chars-forward " \t|&({[") - (setq found (point)))) - (if (>= (point) start) - (progn - (debug "We didn't move!") - (setq found nil)) - (or found - (sh-debug "Did not find prev stmt."))) - found))) - - -(defun sh-get-word () - "Get a shell word skipping whitespace from point." - (interactive) - (skip-chars-forward "\t ") - (let ((start (point))) - (while - (if (looking-at "[\"'`]") - (sh-safe-forward-sexp) - ;; (> (skip-chars-forward "^ \t\n\"'`") 0) - (> (skip-chars-forward "-_$[:alnum:]") 0) - )) - (buffer-substring start (point)) - )) - -(defun sh-prev-thing () - "Return the previous thing this logical line." - ;; This is called when `sh-get-indent-info' is working backwards on - ;; the previous line(s) finding what keywords may be relevant for - ;; indenting. It moves over sexps if possible, and will stop - ;; on a ; and at the beginning of a line if it is not a continuation - ;; line. - ;; - ;; Added a kludge for ";;" - ;; Possible return values: - ;; nil - nothing - ;; a string - possibly a keyword - ;; - (if (bolp) - nil - (let ((start (point)) - (min-point (if (sh-this-is-a-continuation) - (sh-prev-line nil) - (line-beginning-position)))) - (skip-chars-backward " \t;" min-point) - (if (looking-at "\\s-*;[;&]") - ;; (message "Found ;; !") - ";;" - (skip-chars-backward "^)}];\"'`({[" min-point) - (let ((c (if (> (point) min-point) (char-before)))) - (sh-debug "stopping at %d c is %s start=%d min-point=%d" - (point) c start min-point) - (if (not (memq c '(?\n nil ?\;))) - ;; c -- return a string - (char-to-string c) - ;; Return the leading keyword of the "command" we supposedly - ;; skipped over. Maybe we skipped too far (e.g. past a `do' or - ;; `then' that precedes the actual command), so check whether - ;; we're looking at such a keyword and if so, move back forward. - (let ((boundary (point)) - kwd next) - (while - (progn - ;; Skip forward over white space newline and \ at eol. - (skip-chars-forward " \t\n\\\\" start) - (if (>= (point) start) - (progn - (sh-debug "point: %d >= start: %d" (point) start) - nil) - (if next (setq boundary next)) - (sh-debug "Now at %d start=%d" (point) start) - (setq kwd (sh-get-word)) - (if (member kwd (sh-feature sh-leading-keywords)) - (progn - (setq next (point)) - t) - nil)))) - (goto-char boundary) - kwd))))))) - - -(defun sh-this-is-a-continuation () - "Return non-nil if current line is a continuation of previous line." - (save-excursion - (and (zerop (forward-line -1)) - (looking-at ".*\\\\$") - (not (nth 4 (parse-partial-sexp (match-beginning 0) (match-end 0) - nil nil nil t)))))) - -(defun sh-get-kw (&optional where and-move) - "Return first word of line from WHERE. -If AND-MOVE is non-nil then move to end of word." - (let ((start (point))) - (if where - (goto-char where)) - (prog1 - (buffer-substring (point) - (progn (skip-chars-forward "^ \t\n;&|")(point))) - (unless and-move - (goto-char start))))) - -(defun sh-find-prev-matching (open close &optional depth) - "Find a matching token for a set of opening and closing keywords. -This takes into account that there may be nested open..close pairings. -OPEN and CLOSE are regexps denoting the tokens to be matched. -Optional parameter DEPTH (usually 1) says how many to look for." - (let ((parse-sexp-ignore-comments t) - (forward-sexp-function nil) - prev) - (setq depth (or depth 1)) - (save-excursion - (condition-case nil - (while (and - (/= 0 depth) - (not (bobp)) - (setq prev (sh-prev-stmt))) - (goto-char prev) - (save-excursion - (if (looking-at "\\\\\n") - (progn - (forward-char 2) - (skip-chars-forward " \t"))) - (cond - ((looking-at open) - (setq depth (1- depth)) - (sh-debug "found open at %d - depth = %d" (point) depth)) - ((looking-at close) - (setq depth (1+ depth)) - (sh-debug "found close - depth = %d" depth)) - (t - )))) - (error nil)) - (if (eq depth 0) - prev ;; (point) - nil) - ))) - (defun sh-var-value (var &optional ignore-error) "Return the value of variable VAR, interpreting symbols. @@ -3268,620 +2466,16 @@ IGNORE-ERROR is non-nil." "Don't know how to handle %s's value of %s" var val) 0)))) -(defun sh-set-var-value (var value &optional no-symbol) - "Set variable VAR to VALUE. -Unless optional argument NO-SYMBOL is non-nil, then if VALUE is -can be represented by a symbol then do so." - (cond - (no-symbol - (set var value)) - ((= value sh-basic-offset) - (set var '+)) - ((= value (- sh-basic-offset)) - (set var '-)) - ((eq value (* 2 sh-basic-offset)) - (set var '++)) - ((eq value (* 2 (- sh-basic-offset))) - (set var '--)) - ((eq value (/ sh-basic-offset 2)) - (set var '*)) - ((eq value (/ (- sh-basic-offset) 2)) - (set var '/)) - (t - (set var value))) - ) - - -(defun sh-calculate-indent (&optional info) - "Return the indentation for the current line. -If INFO is supplied it is used, else it is calculated from current line." - (let ((ofs 0) - (base-value 0) - elt a b val) - (or info - (setq info (sh-get-indent-info))) - (when info - (while info - (sh-debug "info: %s ofs=%s" info ofs) - (setq elt (car info)) - (cond - ((stringp elt)) ;; do nothing? - ((listp elt) - (setq a (car (car info))) - (setq b (nth 1 (car info))) - (cond - ((eq a t) - (save-excursion - (goto-char b) - (setq val (current-indentation))) - (setq base-value val)) - ((symbolp b) - (setq val (sh-var-value b)) - (cond - ((eq a '=) - (cond - ((null val) - ;; no indentation - ;; set info to nil so we stop immediately - (setq base-value nil ofs nil info nil)) - ((eq val t) (setq ofs 0)) ;; indent as normal line - (t - ;; The following assume the (t POS) come first! - (setq ofs val base-value 0) - (setq info nil)))) ;; ? stop now - ((eq a '+) (setq ofs (+ ofs val))) - ((eq a '-) (setq ofs (- ofs val))) - (t - (error "sh-calculate-indent invalid a a=%s b=%s" a b)))) - (t - (error "sh-calculate-indent invalid elt: a=%s b=%s" a b)))) - (t - (error "sh-calculate-indent invalid elt %s" elt))) - (sh-debug "a=%s b=%s val=%s base-value=%s ofs=%s" - a b val base-value ofs) - (setq info (cdr info))) - ;; return value: - (sh-debug "at end: base-value: %s ofs: %s" base-value ofs) - - (cond - ((or (null base-value)(null ofs)) - nil) - ((and (numberp base-value)(numberp ofs)) - (sh-debug "base (%d) + ofs (%d) = %d" - base-value ofs (+ base-value ofs)) - (+ base-value ofs)) ;; return value - (t - (error "sh-calculate-indent: Help. base-value=%s ofs=%s" - base-value ofs) - nil))))) +(define-obsolete-function-alias 'sh-show-indent + #'smie-config-show-indent "28.1") +(define-obsolete-function-alias 'sh-set-indent #'smie-config-set-indent "28.1") -(defun sh-indent-line () - "Indent the current line." - (interactive) - (let ((indent (sh-calculate-indent)) - (pos (- (point-max) (point)))) - (when indent - (beginning-of-line) - (skip-chars-forward " \t") - (indent-line-to indent) - ;; If initial point was within line's indentation, - ;; position after the indentation. Else stay at same point in text. - (if (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos)))))) - - -(defun sh-blink (blinkpos &optional msg) - "Move cursor momentarily to BLINKPOS and display MSG." - ;; We can get here without it being a number on first line - (if (numberp blinkpos) - (save-excursion - (goto-char blinkpos) - (if msg (message "%s" msg) (message nil)) - (sit-for blink-matching-delay)) - (if msg (message "%s" msg) (message nil)))) - -(defun sh-show-indent (arg) - "Show how the current line would be indented. -This tells you which variable, if any, controls the indentation of -this line. -If optional arg ARG is non-null (called interactively with a prefix), -a pop up window describes this variable. -If variable `sh-blink' is non-nil then momentarily go to the line -we are indenting relative to, if applicable." - (interactive "P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-show-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - (curr-indent (current-indentation)) - val msg) - (if (stringp var) - (message "%s" (setq msg var)) - (setq val (sh-calculate-indent info)) - - (if (eq curr-indent val) - (setq msg (format "%s is %s" var (symbol-value var))) - (setq msg - (if val - (format "%s (%s) would change indent from %d to: %d" - var (symbol-value var) curr-indent val) - (format "%s (%s) would leave line as is" - var (symbol-value var))) - )) - (if (and arg var) - (describe-variable var))) - (if sh-blink - (let ((info (sh-get-indent-info))) - (if (and info (listp (car info)) - (eq (car (car info)) t)) - (sh-blink (nth 1 (car info)) msg) - (message "%s" msg))) - (message "%s" msg)) - ))) +(define-obsolete-function-alias 'sh-learn-line-indent + #'smie-config-set-indent "28.1") -(defun sh-set-indent () - "Set the indentation for the current line. -If the current line is controlled by an indentation variable, prompt -for a new value for it." - (interactive) - (sh-must-support-indent) - (if sh-use-smie - (smie-config-set-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - val old-val indent-val) - (if (stringp var) - (message "Cannot set indent - %s" var) - (setq old-val (symbol-value var)) - (setq val (sh-read-variable var)) - (condition-case nil - (progn - (set var val) - (setq indent-val (sh-calculate-indent info)) - (if indent-val - (message "Variable: %s Value: %s would indent to: %d" - var (symbol-value var) indent-val) - (message "Variable: %s Value: %s would leave line as is." - var (symbol-value var))) - ;; I'm not sure about this, indenting it now? - ;; No. Because it would give the impression that an undo would - ;; restore thing, but the value has been altered. - ;; (sh-indent-line) - ) - (error - (set var old-val) - (message "Bad value for %s, restoring to previous value %s" - var old-val) - (sit-for 1) - nil)) - )))) - - -(defun sh-learn-line-indent (arg) - "Learn how to indent a line as it currently is indented. - -If there is an indentation variable which controls this line's indentation, -then set it to a value which would indent the line the way it -presently is. - -If the value can be represented by one of the symbols then do so -unless optional argument ARG (the prefix when interactive) is non-nil." - (interactive "*P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-set-indent) - ;; I'm not sure if we show allow learning on an empty line. - ;; Though it might occasionally be useful I think it usually - ;; would just be confusing. - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*$")) - (message "sh-learn-line-indent ignores empty lines.") - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - ival sval diff new-val - (no-symbol arg) - (curr-indent (current-indentation))) - (cond - ((stringp var) - (message "Cannot learn line - %s" var)) - ((eq var 'sh-indent-comment) - ;; This is arbitrary... - ;; - if curr-indent is 0, set to curr-indent - ;; - else if it has the indentation of a "normal" line, - ;; then set to t - ;; - else set to curr-indent. - (setq sh-indent-comment - (if (= curr-indent 0) - 0 - (let* ((sh-indent-comment t) - (val2 (sh-calculate-indent info))) - (if (= val2 curr-indent) - t - curr-indent)))) - (message "%s set to %s" var (symbol-value var)) - ) - ((numberp (setq sval (sh-var-value var))) - (setq ival (sh-calculate-indent info)) - (setq diff (- curr-indent ival)) - - (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" - curr-indent ival diff var sval) - (setq new-val (+ sval diff)) - ;; I commented out this because someone might want to replace - ;; a value of `+' with the current value of sh-basic-offset - ;; or vice-versa. - ;;(if (= 0 diff) - ;; (message "No change needed!") - (sh-set-var-value var new-val no-symbol) - (message "%s set to %s" var (symbol-value var)) - ) - (t - (debug) - (message "Cannot change %s" var))))))) - - - -(defun sh-mark-init (buffer) - "Initialize a BUFFER to be used by `sh-mark-line'." - (with-current-buffer (get-buffer-create buffer) - (erase-buffer) - (occur-mode))) - - -(defun sh-mark-line (message point buffer &optional add-linenum occur-point) - "Insert MESSAGE referring to location POINT in current buffer into BUFFER. -Buffer BUFFER is in `occur-mode'. -If ADD-LINENUM is non-nil the message is preceded by the line number. -If OCCUR-POINT is non-nil then the line is marked as a new occurrence -so that `occur-next' and `occur-prev' will work." - (let ((m1 (make-marker)) - start - (line "")) - (when point - (set-marker m1 point (current-buffer)) - (if add-linenum - (setq line (format "%d: " (1+ (count-lines 1 point)))))) - (save-excursion - (if (get-buffer buffer) - (set-buffer (get-buffer buffer)) - (set-buffer (get-buffer-create buffer)) - (occur-mode) - ) - (goto-char (point-max)) - (setq start (point)) - (let ((inhibit-read-only t)) - (insert line) - (if occur-point - (setq occur-point (point))) - (insert message) - (if point - (add-text-properties - start (point) - '(mouse-face highlight - help-echo "mouse-2: go to the line where I learned this"))) - (insert "\n") - (when point - (put-text-property start (point) 'occur-target m1) - (if occur-point - (put-text-property start occur-point - 'occur-match t)) - ))))) - -;; Is this really worth having? -(defvar sh-learned-buffer-hook nil - "An abnormal hook, called with an alist of learned variables.") -;; Example of how to use sh-learned-buffer-hook -;; -;; (defun what-i-learned (list) -;; (let ((p list)) -;; (with-current-buffer "*scratch*" -;; (goto-char (point-max)) -;; (insert "(setq\n") -;; (while p -;; (insert (format " %s %s \n" -;; (nth 0 (car p)) (nth 1 (car p)))) -;; (setq p (cdr p))) -;; (insert ")\n") -;; ))) -;; -;; (add-hook 'sh-learned-buffer-hook #'what-i-learned) - - -;; Originally this was sh-learn-region-indent (beg end) -;; However, in practice this was awkward so I changed it to -;; use the whole buffer. Use narrowing if need be. -(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 -described 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 -there are any discrepancies. - -If no prefix ARG is given, then variables are set to numbers. -If a prefix arg is given, then variables are set to symbols when -applicable -- e.g. to symbol `+' if the value is that of the -basic indent. -If a positive numerical prefix is given, then `sh-basic-offset' -is set to the prefix's numerical value. -Otherwise, sh-basic-offset may or may not be changed, according -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 command can often take a long time to run." - (interactive "P") - (sh-must-support-indent) - (if sh-use-smie - (smie-config-guess) - (save-excursion - (goto-char (point-min)) - (let ((learned-var-list nil) - (out-buffer "*indent*") - (num-diffs 0) - previous-set-info - (max 17) - vec - msg - (comment-col nil) ;; number if all same, t if seen diff values - (comments-always-default t) ;; nil if we see one not default - initial-msg - (specified-basic-offset (and arg (numberp arg) - (> arg 0))) - (linenum 0) - suggested) - (setq vec (make-vector max 0)) - (sh-mark-init out-buffer) - - (if specified-basic-offset - (progn - (setq sh-basic-offset arg) - (setq initial-msg - (format "Using specified sh-basic-offset of %d" - sh-basic-offset))) - (setq initial-msg - (format "Initial value of sh-basic-offset: %s" - sh-basic-offset))) - - (while (< (point) (point-max)) - (setq linenum (1+ linenum)) - ;; (if (zerop (% linenum 10)) - (message "line %d" linenum) - ;; ) - (unless (looking-at "\\s-*$") ;; ignore empty lines! - (let* ((sh-indent-comment t) ;; info must return default indent - (info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - sval ival diff new-val - (curr-indent (current-indentation))) - (cond - ((null var) - nil) - ((stringp var) - nil) - ((numberp (setq sval (sh-var-value var 'no-error))) - ;; the numberp excludes comments since sval will be t. - (setq ival (sh-calculate-indent)) - (setq diff (- curr-indent ival)) - (setq new-val (+ sval diff)) - (sh-set-var-value var new-val 'no-symbol) - (unless (looking-at "\\s-*#") ;; don't learn from comments - (if (setq previous-set-info (assoc var learned-var-list)) - (progn - ;; it was already there, is it same value ? - (unless (eq (symbol-value var) - (nth 1 previous-set-info)) - (sh-mark-line - (format "Variable %s was set to %s" - var (symbol-value var)) - (point) out-buffer t t) - (sh-mark-line - (format " but was previously set to %s" - (nth 1 previous-set-info)) - (nth 2 previous-set-info) out-buffer t) - (setq num-diffs (1+ num-diffs)) - ;; (delete previous-set-info learned-var-list) - (setcdr previous-set-info - (list (symbol-value var) (point))) - ) - ) - (setq learned-var-list - (append (list (list var (symbol-value var) - (point))) - learned-var-list))) - (if (numberp new-val) - (progn - (sh-debug - "This line's indent value: %d" new-val) - (if (< new-val 0) - (setq new-val (- new-val))) - (if (< new-val max) - (aset vec new-val (1+ (aref vec new-val)))))) - )) - ((eq var 'sh-indent-comment) - (unless (= curr-indent (sh-calculate-indent info)) - ;; this is not the default indentation - (setq comments-always-default nil) - (if comment-col ;; then we have see one before - (or (eq comment-col curr-indent) - (setq comment-col t)) ;; seen a different one - (setq comment-col curr-indent)) - )) - (t - (sh-debug "Cannot learn this line!!!") - )) - (sh-debug - "at %s learned-var-list is %s" (point) learned-var-list) - )) - (forward-line 1) - ) ;; while - (if sh-debug - (progn - (setq msg (format - "comment-col = %s comments-always-default = %s" - comment-col comments-always-default)) - ;; (message msg) - (sh-mark-line msg nil out-buffer))) - (cond - ((eq comment-col 0) - (setq msg "\nComments are all in 1st column.\n")) - (comments-always-default - (setq msg "\nComments follow default indentation.\n") - (setq comment-col t)) - ((numberp comment-col) - (setq msg (format "\nComments are in col %d." comment-col))) - (t - (setq msg "\nComments seem to be mixed, leaving them as is.\n") - (setq comment-col nil) - )) - (sh-debug msg) - (sh-mark-line msg nil out-buffer) - - (sh-mark-line initial-msg nil out-buffer t t) - - (setq suggested (sh-guess-basic-offset vec)) - - (if (and suggested (not specified-basic-offset)) - (let ((new-value - (cond - ;; t => set it if we have a single value as a number - ((and (eq sh-learn-basic-offset t) (numberp suggested)) - suggested) - ;; other non-nil => set it if only one value was found - (sh-learn-basic-offset - (if (numberp suggested) - suggested - (if (= (length suggested) 1) - (car suggested)))) - (t - nil)))) - (if new-value - (progn - (setq learned-var-list - (append (list (list 'sh-basic-offset - (setq sh-basic-offset new-value) - (point-max))) - learned-var-list)) - ;; Not sure if we need to put this line in, since - ;; it will appear in the "Learned variable settings". - (sh-mark-line - (format "Changed sh-basic-offset to: %d" sh-basic-offset) - nil out-buffer)) - (sh-mark-line - (if (listp suggested) - (format "Possible value(s) for sh-basic-offset: %s" - (mapconcat 'int-to-string suggested " ")) - (format "Suggested sh-basic-offset: %d" suggested)) - nil out-buffer)))) - - - (setq learned-var-list - (append (list (list 'sh-indent-comment comment-col (point-max))) - learned-var-list)) - (setq sh-indent-comment comment-col) - (let ((name (buffer-name))) - (sh-mark-line "\nLearned variable settings:" nil out-buffer) - (if arg - ;; Set learned variables to symbolic rather than numeric - ;; values where possible. - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var)) - (val (nth 1 learned-var))) - (when (and (not (eq var 'sh-basic-offset)) - (numberp val)) - (sh-set-var-value var val))))) - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var))) - (sh-mark-line (format " %s %s" var (symbol-value var)) - (nth 2 learned-var) out-buffer))) - (with-current-buffer out-buffer - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (insert - (format "Indentation values for buffer %s.\n" name) - (format "%d indentation variable%s different values%s\n\n" - num-diffs - (if (= num-diffs 1) - " has" "s have") - (if (zerop num-diffs) - "." ":")))))) - (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) - (and (called-interactively-p 'any) - (or sh-popup-occur-buffer (> num-diffs 0)) - (pop-to-buffer out-buffer)))))) - -(defun sh-guess-basic-offset (vec) - "See if we can determine a reasonable value for `sh-basic-offset'. -This is experimental, heuristic and arbitrary! -Argument VEC is a vector of information collected by -`sh-learn-buffer-indent'. -Return values: - number - there appears to be a good single value - list of numbers - no obvious one, here is a list of one or more - reasonable choices - nil - we couldn't find a reasonable one." - (let* ((max (1- (length vec))) - (i 1) - (totals (make-vector max 0))) - (while (< i max) - (cl-incf (aref totals i) (* 4 (aref vec i))) - (if (zerop (% i 2)) - (cl-incf (aref totals i) (aref vec (/ i 2)))) - (if (< (* i 2) max) - (cl-incf (aref totals i) (aref vec (* i 2)))) - (setq i (1+ i))) - - (let ((x nil) - (result nil) - tot sum p) - (setq i 1) - (while (< i max) - (if (/= (aref totals i) 0) - (push (cons i (aref totals i)) x)) - (setq i (1+ i))) - - (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b))))) - (setq tot (apply '+ (append totals nil))) - (sh-debug (format "vec: %s\ntotals: %s\ntot: %d" - vec totals tot)) - (cond - ((zerop (length x)) - (message "no values!")) ;; we return nil - ((= (length x) 1) - (message "only value is %d" (car (car x))) - (setq result (car (car x)))) ;; return single value - ((> (cdr (car x)) (/ tot 2)) - ;; 1st is > 50% - (message "basic-offset is probably %d" (car (car x))) - (setq result (car (car x)))) ;; again, return a single value - ((>= (cdr (car x)) (* 2 (cdr (car (cdr x))))) - ;; 1st is >= 2 * 2nd - (message "basic-offset could be %d" (car (car x))) - (setq result (car (car x)))) - ((>= (+ (cdr (car x))(cdr (car (cdr x)))) (/ tot 2)) - ;; 1st & 2nd together >= 50% - return a list - (setq p x sum 0 result nil) - (while (and p - (<= (setq sum (+ sum (cdr (car p)))) (/ tot 2))) - (setq result (append result (list (car (car p))))) - (setq p (cdr p))) - (message "Possible choices for sh-basic-offset: %s" - (mapconcat 'int-to-string result " "))) - (t - (message "No obvious value for sh-basic-offset. Perhaps %d" - (car (car x))) - ;; result is nil here - )) - result))) +(define-obsolete-function-alias 'sh-learn-buffer-indent + #'smie-config-guess "28.1") ;; ======================================================================== diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 400e304ecf4..5eb8701d08a 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -905,7 +905,7 @@ it automatically." (const :tag "Default Terminator" t) (string :tag "Terminator String") (cons :tag "Terminator Pattern and String" - (string :tag "Terminator Pattern") + (regexp :tag "Terminator Pattern") (string :tag "Terminator String"))) :version "22.2" :group 'SQL) @@ -1033,7 +1033,7 @@ All products share this list; products should define a regexp to identify additional keywords in a variable defined by the :statement feature." :version "24.1" - :type 'string + :type 'regexp :group 'SQL) ;; Customization for Oracle diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 460957b7161..cc601601193 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -958,8 +958,8 @@ See `compilation-error-regexp-alist-alist' for the formatting. For XEmacs.") ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 1 bold t) ("syntax error:.*\n\\([^ \t]+\\) *\\([0-9]+\\):" 2 bold t) ;; verilog-verilator - (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) - (".*%?\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) + (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 3 bold t) + (".*\\(Error\\|Warning\\)\\(-[^:]+\\|\\):[\n ]*\\([^ \t:]+\\):\\([0-9]+\\):" 4 bold t) ;; verilog-leda ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 1 bold t) ("^In file \\([^ \t]+\\)[ \t]+line[ \t]+\\([0-9]+\\):\n[^\n]*\n[^\n]*\n\\(Warning\\|Error\\|Failure\\)[^\n]*" 2 bold t) @@ -5345,7 +5345,7 @@ becomes: (interactive) (save-excursion (beginning-of-line) - (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\):?.*$") + (when (looking-at "\\(.*\\)([WE]\\([0-9A-Z]+\\)).*,\\s +line\\s +[0-9]+:\\s +\\([^:\n]+\\).*$") (replace-match (format ;; %3s makes numbers 1-999 line up nicely "\\1//Verilint %3s off // WARNING: \\3" @@ -6788,7 +6788,7 @@ Do not count named blocks or case-statements." ((looking-at verilog-named-block-re) (current-column)) ((and (not (looking-at verilog-extended-case-re)) - (looking-at "^[^:;]+[ \t]*:")) + (looking-at "^[^:;]+:")) (verilog-re-search-forward ":" nil t) (skip-chars-forward " \t") (current-column)) @@ -7782,7 +7782,7 @@ If search fails, other files are checked based on "Return point if within translate-off region, else nil." (and (save-excursion (re-search-backward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "\\(on\\|off\\)\\>") + (concat "//.*" verilog-directive-regexp "\\(on\\|off\\)\\>") nil t)) (equal "off" (match-string 2)) (point))) @@ -7790,14 +7790,14 @@ If search fails, other files are checked based on (defun verilog-start-translate-off (limit) "Return point before translate-off directive if before LIMIT, else nil." (when (re-search-forward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>") + (concat "//.*" verilog-directive-regexp "off\\>") limit t) (match-beginning 0))) (defun verilog-back-to-start-translate-off (limit) "Return point before translate-off directive if before LIMIT, else nil." (when (re-search-backward - (concat "//\\s-*.*\\s-*" verilog-directive-regexp "off\\>") + (concat "//.*" verilog-directive-regexp "off\\>") limit t) (match-beginning 0))) @@ -7805,7 +7805,7 @@ If search fails, other files are checked based on "Return point after translate-on directive if before LIMIT, else nil." (re-search-forward (concat - "//\\s-*.*\\s-*" verilog-directive-regexp "on\\>") limit t)) + "//.*" verilog-directive-regexp "on\\>") limit t)) (defun verilog-match-translate-off (limit) "Match a translate-off block, setting `match-data' and returning t, else nil. @@ -9982,7 +9982,7 @@ Or, just the existing dirnames themselves if there are no wildcards." (while dirnames (setq dirname (car dirnames) dirnames (cdr dirnames)) - (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root + (cond ((string-match (concat "^\\(\\|[^*?]*[/\\]\\)" ; root "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? "\\(.*\\)") ; rest dirname) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index b225a9b1d9a..0677d36fbc7 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -16148,7 +16148,7 @@ expansion function)." ;; initialize speedbar (if (not (boundp 'speedbar-frame)) - (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize) + (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)) (vhdl-speedbar-initialize) (when speedbar-frame (vhdl-speedbar-refresh))) diff --git a/lisp/recentf.el b/lisp/recentf.el index b636e594864..27918a9739c 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -277,6 +277,8 @@ If `file-name-history' is not empty, do nothing." "Normal hook run at end of loading the `recentf' package." :group 'recentf :type 'hook) +(make-obsolete-variable 'recentf-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom recentf-filename-handlers nil "Functions to post process recent file names. diff --git a/lisp/registry.el b/lisp/registry.el index 7d95d91ad2c..ef47f07aec5 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -317,7 +317,7 @@ Errors out if the key exists already." (message "reindexing: %d of %d (%.2f%%)" count expected (/ (* 100.0 count) expected))) (dolist (val (cdr-safe (assq tr v))) - (let* ((value-keys (registry-lookup-secondary-value db tr val))) + (let ((value-keys (registry-lookup-secondary-value db tr val))) (push key value-keys) (registry-lookup-secondary-value db tr val value-keys)))) (oref db data)))))) diff --git a/lisp/sb-image.el b/lisp/sb-image.el deleted file mode 100644 index 1e8b1057bc8..00000000000 --- a/lisp/sb-image.el +++ /dev/null @@ -1,107 +0,0 @@ -;;; sb-image --- Image management for speedbar - -;; Copyright (C) 1999-2003, 2005-2020 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Keywords: file, tags, 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 <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Supporting Image display for Emacs 20 and less, Emacs 21, and XEmacs, -;; is a challenging task, which doesn't take kindly to being byte compiled. -;; When sharing speedbar.elc between these three applications, the Image -;; support can get lost. -;; -;; By splitting out that hard part into this file, and avoiding byte -;; compilation, one copy speedbar can support all these platforms together. -;; -;; This file requires the `image' package if it is available. - -(require 'ezimage) - -;;; Code: -(defcustom speedbar-use-images ezimage-use-images - "Non-nil if speedbar should display icons." - :group 'speedbar - :version "21.1" - :type 'boolean) - -(defalias 'defimage-speedbar 'defezimage) - -(defvar speedbar-expand-image-button-alist - '(("<+>" . ezimage-directory-plus) - ("<->" . ezimage-directory-minus) - ("< >" . ezimage-directory) - ("[+]" . ezimage-page-plus) - ("[-]" . ezimage-page-minus) - ("[?]" . ezimage-page) - ("[ ]" . ezimage-page) - ("{+}" . ezimage-box-plus) - ("{-}" . ezimage-box-minus) - ("<M>" . ezimage-mail) - ("<d>" . ezimage-document-tag) - ("<i>" . ezimage-info-tag) - (" =>" . ezimage-tag) - (" +>" . ezimage-tag-gt) - (" ->" . ezimage-tag-v) - (">" . ezimage-tag) - ("@" . ezimage-tag-type) - (" @" . ezimage-tag-type) - ("*" . ezimage-checkout) - ("#" . ezimage-object) - ("!" . ezimage-object-out-of-date) - ("//" . ezimage-label) - ("%" . ezimage-lock) - ) - "List of text and image associations.") - -(defun speedbar-insert-image-button-maybe (start length) - "Insert an image button based on text starting at START for LENGTH chars. -If buttontext is unknown, just insert that text. -If we have an image associated with it, use that image." - (when speedbar-use-images - (let ((ezimage-expand-image-button-alist - speedbar-expand-image-button-alist)) - (ezimage-insert-image-button-maybe start length)))) - -(defun speedbar-image-dump () - "Dump out the current state of the Speedbar image alist. -See `speedbar-expand-image-button-alist' for details." - (interactive) - (with-output-to-temp-buffer "*Speedbar Images*" - (with-current-buffer "*Speedbar Images*" - (goto-char (point-max)) - (insert "Speedbar image cache.\n\n") - (let ((start (point)) (end nil)) - (insert "Image\tText\tImage Name") - (setq end (point)) - (insert "\n") - (put-text-property start end 'face 'underline)) - (let ((ia speedbar-expand-image-button-alist)) - (while ia - (let ((start (point))) - (insert (car (car ia))) - (insert "\t") - (speedbar-insert-image-button-maybe start - (length (car (car ia)))) - (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n")) - (setq ia (cdr ia))))))) - -(provide 'sb-image) - -;;; sb-image.el ends here diff --git a/lisp/shell.el b/lisp/shell.el index ecebf937e29..1e2679f7235 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -252,7 +252,7 @@ This mirrors the optional behavior of tcsh." (defcustom shell-chdrive-regexp (if (memq system-type '(ms-dos windows-nt)) ; NetWare allows the five chars between upper and lower alphabetics. - "[]a-zA-Z^_`\\[\\\\]:" + "[]a-zA-Z^_`[\\]:" nil) "If non-nil, is regexp used to track drive changes." :type '(choice regexp @@ -377,7 +377,7 @@ Thus, this does not include the shell's current directory.") "\\|\\$\\(?:\\([[:alpha:]][[:alnum:]]*\\)" "\\|{\\(?1:[^{}]+\\)}\\)" (when (memq system-type '(ms-dos windows-nt)) - "\\|%\\(?1:[^\\\\/]*\\)%") + "\\|%\\(?1:[^\\/]*\\)%") (when comint-file-name-quote-list "\\|\\\\\\(.\\)"))) (qupos nil) diff --git a/lisp/simple.el b/lisp/simple.el index 0d8072bf5f0..688dbcc947b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1213,6 +1213,10 @@ that uses or sets the mark." ;; Counting lines, one way or another. +(defvar goto-line-history nil + "History of values entered with `goto-line'.") +(make-variable-buffer-local 'goto-line-history) + (defun goto-line (line &optional buffer) "Go to LINE, counting from line 1 at beginning of buffer. If called interactively, a numeric prefix argument specifies @@ -1257,7 +1261,8 @@ rather than line counts." ""))) ;; Read the argument, offering that number (if any) as default. (list (read-number (format "Goto line%s: " buffer-prompt) - (list default (line-number-at-pos))) + (list default (line-number-at-pos)) + 'goto-line-history) buffer)))) ;; Switch to the desired buffer, one way or another. (if buffer @@ -1783,23 +1788,36 @@ to get different commands to edit and resubmit." ;; and it serves as a shorthand for "Extended command: ". "M-x ") (lambda (string pred action) - (let ((pred - (if (memq action '(nil t)) - ;; Exclude obsolete commands from completions. - (lambda (sym) - (and (funcall pred sym) - (or (equal string (symbol-name sym)) - (not (get sym 'byte-obsolete-info))))) - pred))) - (complete-with-action action obarray string pred))) + (if (and suggest-key-bindings (eq action 'metadata)) + '(metadata + (annotation-function . read-extended-command--annotation) + (category . command)) + (let ((pred + (if (memq action '(nil t)) + ;; Exclude obsolete commands from completions. + (lambda (sym) + (and (funcall pred sym) + (or (equal string (symbol-name sym)) + (not (get sym 'byte-obsolete-info))))) + pred))) + (complete-with-action action obarray string pred)))) #'commandp t nil 'extended-command-history))) +(defun read-extended-command--annotation (command-name) + (let* ((function (and (stringp command-name) (intern-soft command-name))) + (binding (where-is-internal function overriding-local-map t))) + (when (and binding (not (stringp binding))) + (format " (%s)" (key-description binding))))) + (defcustom suggest-key-bindings t "Non-nil means show the equivalent key-binding when M-x command has one. The value can be a length of time to show the message for. If the value is non-nil and not a number, we wait 2 seconds. -Also see `extended-command-suggest-shorter'." +Also see `extended-command-suggest-shorter'. + +Equivalent key-bindings are also shown in the completion list of +M-x for all commands that have them." :group 'keyboard :type '(choice (const :tag "off" nil) (integer :tag "time" 2) @@ -2514,6 +2532,11 @@ A redo record for ordinary undo maps to the following (earlier) undo.") "Within a run of consecutive undo commands, list remaining to be undone. If t, we undid all the way to the end of it.") +(defun undo--last-change-was-undo-p (undo-list) + (while (and (consp undo-list) (eq (car undo-list) nil)) + (setq undo-list (cdr undo-list))) + (gethash undo-list undo-equiv-table)) + (defun undo (&optional arg) "Undo some previous changes. Repeat this command to undo more changes. @@ -2549,12 +2572,7 @@ as an argument limits undo to changes within the current region." (or (eq pending-undo-list t) ;; If something (a timer or filter?) changed the buffer ;; since the previous command, don't continue the undo seq. - (let ((list buffer-undo-list)) - (while (eq (car list) nil) - (setq list (cdr list))) - ;; If the last undo record made was made by undo - ;; it shows nothing else happened in between. - (gethash list undo-equiv-table)))) + (undo--last-change-was-undo-p buffer-undo-list))) (setq undo-in-region (and (or (region-active-p) (and arg (not (numberp arg)))) (not inhibit-region))) @@ -2644,6 +2662,25 @@ Contrary to `undo', this will not redo a previous undo." (interactive "*p") (let ((undo-no-redo t)) (undo arg))) +(defun undo-redo (&optional arg) + "Undo the last ARG undos." + (interactive "*p") + (cond + ((not (undo--last-change-was-undo-p buffer-undo-list)) + (user-error "No undo to undo")) + (t + (let* ((ul buffer-undo-list) + (new-ul + (let ((undo-in-progress t)) + (while (and (consp ul) (eq (car ul) nil)) + (setq ul (cdr ul))) + (primitive-undo arg ul))) + (new-pul (undo--last-change-was-undo-p new-ul))) + (message "Redo%s" (if undo-in-region " in region" "")) + (setq this-command 'undo) + (setq pending-undo-list new-pul) + (setq buffer-undo-list new-ul))))) + (defvar undo-in-progress nil "Non-nil while performing an undo. Some change-hooks test this variable to do something different.") diff --git a/lisp/so-long.el b/lisp/so-long.el index dcf7e62ca74..6b05f4821b1 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -353,7 +353,7 @@ ;; this caveat is the `mode' pseudo-variable, which is processed early in all ;; versions of Emacs, and can be set to `so-long-mode' if desired. -;;; * Change Log: +;; * Change Log: ;; ;; 1.0 - Included in Emacs 27.1, and in GNU ELPA for prior versions of Emacs. ;; - New global mode `global-so-long-mode' to enable/disable the library. @@ -944,8 +944,10 @@ This command calls `so-long' with the selected action as an argument.") (cl-letf (((symbol-function 'finder-summary) #'ignore)) (finder-commentary "so-long")) (let ((inhibit-read-only t)) - (when (looking-at "^Commentary:\n\n") - (replace-match "so-long.el\n\n")) + (if (looking-at "^Commentary:\n\n") + (replace-match "so-long.el\n\n") + (insert "so-long.el\n") + (forward-line 1)) (save-excursion (while (re-search-forward "^-+$" nil :noerror) (replace-match "")))) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 4cd4fb9161d..faa0bcc540d 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -115,7 +115,7 @@ this version is not backward compatible to 0.14 or earlier.") (require 'easymenu) (require 'dframe) -(require 'sb-image) +(require 'ezimage) ;; customization stuff (defgroup speedbar nil @@ -141,6 +141,12 @@ this version is not backward compatible to 0.14 or earlier.") :prefix "speedbar-" :group 'speedbar) +(defcustom speedbar-use-images ezimage-use-images + "Non-nil if speedbar should display icons." + :group 'speedbar + :version "21.1" + :type 'boolean) + ;;; Code: ;; Note: `inversion-test' requires parts of the CEDET package that are @@ -296,6 +302,8 @@ The default buffer is the buffer in the selected window in the attached frame." "Hooks run when speedbar is loaded." :group 'speedbar :type 'hook) +(make-obsolete-variable 'speedbar-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom speedbar-reconfigure-keymaps-hook nil "Hooks run when the keymaps are regenerated." @@ -641,7 +649,7 @@ They should include commonly existing directories which are not useful. It is no longer necessary to include version-control directories here; see `vc-directory-exclusion-list'." :group 'speedbar - :type 'string) + :type 'regexp) (defcustom speedbar-file-unshown-regexp (let ((nstr "") (noext completion-ignored-extensions)) @@ -654,7 +662,7 @@ directories here; see `vc-directory-exclusion-list'." "Regexp matching files we don't want displayed in a speedbar buffer. It is generated from the variable `completion-ignored-extensions'." :group 'speedbar - :type 'string) + :type 'regexp) (defvar speedbar-file-regexp nil "Regular expression matching files we know how to expand. @@ -1703,7 +1711,7 @@ argument." (put-text-property start end 'help-echo #'dframe-help-echo)) (if function (put-text-property start end 'speedbar-function function)) (if token (put-text-property start end 'speedbar-token token)) - ;; So far the only text we have is less that 3 chars. + ;; So far the only text we have is less than 3 chars. (if (<= (- end start) 3) (speedbar-insert-image-button-maybe start (- end start))) ) @@ -4022,6 +4030,68 @@ TEXT is the buffer's name, TOKEN and INDENT are unused." (setq font-lock-global-modes (delq 'speedbar-mode font-lock-global-modes))))) +;;; Image management + +(defvar speedbar-expand-image-button-alist + '(("<+>" . ezimage-directory-plus) + ("<->" . ezimage-directory-minus) + ("< >" . ezimage-directory) + ("[+]" . ezimage-page-plus) + ("[-]" . ezimage-page-minus) + ("[?]" . ezimage-page) + ("[ ]" . ezimage-page) + ("{+}" . ezimage-box-plus) + ("{-}" . ezimage-box-minus) + ("<M>" . ezimage-mail) + ("<d>" . ezimage-document-tag) + ("<i>" . ezimage-info-tag) + (" =>" . ezimage-tag) + (" +>" . ezimage-tag-gt) + (" ->" . ezimage-tag-v) + (">" . ezimage-tag) + ("@" . ezimage-tag-type) + (" @" . ezimage-tag-type) + ("*" . ezimage-checkout) + ("#" . ezimage-object) + ("!" . ezimage-object-out-of-date) + ("//" . ezimage-label) + ("%" . ezimage-lock) + ) + "List of text and image associations.") + +(defun speedbar-insert-image-button-maybe (start length) + "Insert an image button based on text starting at START for LENGTH chars. +If buttontext is unknown, just insert that text. +If we have an image associated with it, use that image." + (when speedbar-use-images + (let ((ezimage-expand-image-button-alist + speedbar-expand-image-button-alist)) + (ezimage-insert-image-button-maybe start length)))) + +(defun speedbar-image-dump () + "Dump out the current state of the Speedbar image alist. +See `speedbar-expand-image-button-alist' for details." + (interactive) + (with-output-to-temp-buffer "*Speedbar Images*" + (with-current-buffer "*Speedbar Images*" + (goto-char (point-max)) + (insert "Speedbar image cache.\n\n") + (let ((start (point)) (end nil)) + (insert "Image\tText\tImage Name") + (setq end (point)) + (insert "\n") + (put-text-property start end 'face 'underline)) + (let ((ia speedbar-expand-image-button-alist)) + (while ia + (let ((start (point))) + (insert (car (car ia))) + (insert "\t") + (speedbar-insert-image-button-maybe start + (length (car (car ia)))) + (insert (car (car ia)) "\t" (format "%s" (cdr (car ia))) "\n")) + (setq ia (cdr ia))))))) + + (provide 'speedbar) ;; run load-time hooks diff --git a/lisp/strokes.el b/lisp/strokes.el index 7a88744540b..7c00305835b 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -296,6 +296,8 @@ the corresponding interactive function.") (defvar strokes-load-hook nil "Functions to be called when Strokes is loaded.") +(make-obsolete-variable 'strokes-load-hook + "use `with-eval-after-load' instead." "28.1") ;;; ### NOT IMPLEMENTED YET ### ;;(defvar edit-strokes-menu diff --git a/lisp/subr.el b/lisp/subr.el index c1c4cad18d1..b5ec0de156a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2521,10 +2521,15 @@ by doing (clear-string STRING)." ;; And of course, don't keep the sensitive data around. (erase-buffer)))))))) -(defun read-number (prompt &optional default) +(defvar read-number-history nil + "The default history for the `read-number' function.") + +(defun read-number (prompt &optional default hist) "Read a numeric value in the minibuffer, prompting with PROMPT. DEFAULT specifies a default value to return if the user just types RET. The value of DEFAULT is inserted into PROMPT. +HIST specifies a history list variable. See `read-from-minibuffer' +for details of the HIST argument. This function is used by the `interactive' code letter `n'." (let ((n nil) (default1 (if (consp default) (car default) default))) @@ -2538,7 +2543,7 @@ This function is used by the `interactive' code letter `n'." (while (progn (let ((str (read-from-minibuffer - prompt nil nil nil nil + prompt nil nil nil (or hist 'read-number-history) (when default (if (consp default) (mapcar 'number-to-string (delq nil default)) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index fac27f41ba9..873f54a27db 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1467,8 +1467,7 @@ This is an action function for buffer display, see Info node `(elisp) Buffer Display Action Functions'. It should be called only by `display-buffer' or a function directly or indirectly called by the latter." - (let* ((tab-name (alist-get 'tab-name alist)) - (reusable-frames (alist-get 'reusable-frames alist)) + (let* ((reusable-frames (alist-get 'reusable-frames alist)) (reusable-tab (when reusable-frames (tab-bar-get-buffer-tab buffer reusable-frames)))) (if reusable-tab @@ -1480,26 +1479,55 @@ indirectly called by the latter." (tab-bar-select-tab (1+ index))) (when (get-buffer-window buffer frame) (select-window (get-buffer-window buffer frame)))) + (let ((tab-name (alist-get 'tab-name alist))) + (when (functionp tab-name) + (setq tab-name (funcall tab-name buffer alist))) + (if tab-name + (let ((tab-index (tab-bar--tab-index-by-name tab-name))) + (if tab-index + (progn + (tab-bar-select-tab (1+ tab-index)) + (when (get-buffer-window buffer) + (select-window (get-buffer-window buffer)))) + (display-buffer-in-new-tab buffer alist))) + (display-buffer-in-new-tab buffer alist)))))) + +(defun display-buffer-in-new-tab (buffer alist) + "Display BUFFER in a new tab. +ALIST is an association list of action symbols and values. See +Info node `(elisp) Buffer Display Action Alists' for details of +such alists. + +Like `display-buffer-in-tab', but always creates a new tab unconditionally, +without checking if a suitable tab already exists. + +If ALIST contains a `tab-name' entry, it creates a new tab with that name +and displays BUFFER in a new tab. The `tab-name' entry can be a function, +then it is called with two arguments: BUFFER and ALIST, and should return +the tab name. When a `tab-name' entry is omitted, create a new tab without +an explicit name. + +This is an action function for buffer display, see Info +node `(elisp) Buffer Display Action Functions'. It should be +called only by `display-buffer' or a function directly or +indirectly called by the latter." + (let ((tab-bar-new-tab-choice t)) + (tab-bar-new-tab) + (let ((tab-name (alist-get 'tab-name alist))) (when (functionp tab-name) (setq tab-name (funcall tab-name buffer alist))) - (if tab-name - (let ((tab-index (tab-bar--tab-index-by-name tab-name))) - (if tab-index - (tab-bar-select-tab (1+ tab-index)) - (let ((tab-bar-new-tab-choice t)) - (tab-bar-new-tab) - (tab-bar-rename-tab tab-name)))) - (let ((tab-bar-new-tab-choice t)) - (tab-bar-new-tab)))))) + (when tab-name + (tab-bar-rename-tab tab-name))) + (window--display-buffer buffer (selected-window) 'tab alist))) (defun switch-to-buffer-other-tab (buffer-or-name &optional norecord) "Switch to buffer BUFFER-OR-NAME in another tab. Like \\[switch-to-buffer-other-frame] (which see), but creates a new tab." (interactive (list (read-buffer-to-switch "Switch to buffer in other tab: "))) - (display-buffer buffer-or-name '((display-buffer-in-tab - display-buffer-same-window) - (inhibit-same-window . nil)) + (display-buffer buffer-or-name '((display-buffer-in-tab) + (inhibit-same-window . nil) + (reusable-frames . t)) norecord)) (defun find-file-other-tab (filename &optional wildcards) diff --git a/lisp/term.el b/lisp/term.el index 09dfeb61d17..b990c83cfcb 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2796,12 +2796,12 @@ See `term-prompt-regexp'." "\\(?:[\r\n\000\007\t\b\016\017]\\|" ;; some Emacs specific control sequences, implemented by ;; `term-command-hook', - "\032[^\n]+\r?\n\\|" + "\032[^\n]+\n\\|" ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements ;; of the C1 set"), "\e\\(?:[DM78c]\\|" ;; another Emacs specific control sequence, - "AnSiT[^\n]+\r?\n\\|" + "AnSiT[^\n]+\n\\|" ;; or an escape sequence (section 5.4 "Control Sequences"), "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)") "Regexp matching control sequences handled by term.el.") diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 90024b001f7..6acf6cd1992 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -314,10 +314,9 @@ The overlay is assigned the face `ns-working-text-face'." (interactive) (ns-delete-working-text) (let ((start (point))) - (insert ns-working-text) - (overlay-put (setq ns-working-overlay (make-overlay start (point) - (current-buffer) nil t)) - 'face 'ns-working-text-face))) + (overlay-put (setq ns-working-overlay (make-overlay start (point))) + 'after-string + (propertize ns-working-text 'face 'ns-working-text-face)))) (defun ns-echo-working-text () "Echo contents of `ns-working-text' in message display area. @@ -340,8 +339,7 @@ See `ns-insert-working-text'." ;; Still alive? (overlay-buffer ns-working-overlay)) (with-current-buffer (overlay-buffer ns-working-overlay) - (delete-region (overlay-start ns-working-overlay) - (overlay-end ns-working-overlay)) + (overlay-put ns-working-overlay 'after-string nil) (delete-overlay ns-working-overlay))) ((integerp ns-working-overlay) (let ((msg (current-message)) diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 4c24e70d1f7..39a1b488a74 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -89,7 +89,7 @@ EXCEPTION-LIST is a list of strings. The checked word is downcased before comparing with these exceptions." :group 'flyspell :type '(alist :key-type (choice (const :tag "All dictionaries" nil) - string) + regexp) :value-type (repeat string)) :version "24.1") @@ -234,7 +234,7 @@ Ispell's ultimate default dictionary." "A string that is the regular expression that matches TeX commands." :group 'flyspell :version "21.1" - :type 'string) + :type 'regexp) (defcustom flyspell-check-tex-math-command nil "Non-nil means check even inside TeX math environment. diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 99c3e471241..e22e3f48994 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -168,7 +168,7 @@ to obtain the value of this variable." (defcustom sentence-end-base "[.?!…‽][]\"'â€â€™)}»›]*" "Regexp matching the basic end of a sentence, not including following space." :group 'paragraphs - :type 'string + :type 'regexp :version "25.1") (put 'sentence-end-base 'safe-local-variable 'stringp) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index ca92541331e..c9fd19d2324 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -925,7 +925,7 @@ DOWNCASE t: Downcase words before using them." "\\<label[[:space:]]*=[[:space:]]*" ;; Match the label value; braces around the value are ;; optional. - "{?\\(?1:[^] ,}\r\n\t%]+\\)}?" + "{?\\(?1:[^] ,}\r\n\t%]+\\)" ;; We are done. Just search until the next closing bracket "[^]]*\\]")) "List of regexps matching \\label definitions. @@ -2100,6 +2100,8 @@ construct: \\bbb [xxx] {aaa}." "Hook which is being run when loading reftex.el." :group 'reftex-miscellaneous-configurations :type 'hook) +(make-obsolete-variable 'reftex-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom reftex-mode-hook nil "Hook which is being run when turning on RefTeX mode." diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 542f1fef14e..4071c0dd074 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -2371,7 +2371,7 @@ what in fact did happen. Check if the bug is reproducible with an up-to-date version of RefTeX available from https://www.gnu.org/software/auctex/. -If the bug is triggered by a specific \(La)TeX file, you should try +If the bug is triggered by a specific (La)TeX file, you should try to produce a minimal sample file showing the problem and include it in your report. diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 4482e7d4d23..7f87ee3646d 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -793,6 +793,8 @@ simply by any key input." "List of functions to be called after the table is first loaded." :type 'hook :group 'table-hooks) +(make-obsolete-variable 'table-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom table-point-entered-cell-hook nil "List of functions to be called after point entered a table cell." @@ -3206,11 +3208,7 @@ CALS (DocBook DTD): (while (and (re-search-forward "$" nil t) (not (eobp))) (insert "<br />") - (forward-char 1))) - (unless (and table-html-delegate-spacing-to-user-agent - (progn - (goto-char (point-min)) - (looking-at "\\s *\\'"))))) + (forward-char 1)))) ((eq language 'cals) (table--remove-eol-spaces (point-min) (point-max)) (if (re-search-forward "\\s +\\'" nil t) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 0e28756ea75..f95979e2fcb 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -465,7 +465,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ; ("{\\\\bf\\([^}]+\\)}" 1 'bold keep) ; ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep) ; ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face) -; ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep)) +; ("^[ \t\n]*\\\\def[\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep)) ; ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>. ; '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}" ; 2 font-lock-function-name-face) @@ -1252,10 +1252,10 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "") ("%" . "$")))) ;; A line containing just $$ is treated as a paragraph separator. - (setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$") + (setq-local paragraph-start "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$") ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. - (setq-local paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$") + (setq-local paragraph-separate "[ \t]*$\\|[\f\\%]\\|[ \t]*\\$\\$[ \t]*$") (setq-local add-log-current-defun-function #'tex-current-defun-name) (setq-local comment-start "%") (setq-local comment-add 1) diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 25f37ffa23d..398f7fdc232 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -67,7 +67,7 @@ matching the white space). The pattern is matched case-sensitive regardless of the value of `case-fold-search' setting." :version "25.1" :group 'tildify - :type 'string + :type 'regexp :safe t) (defcustom tildify-pattern-alist () @@ -417,7 +417,7 @@ of a space at point. The regexp is always case sensitive, regardless of the current `case-fold-search' setting." :version "25.1" :group 'tildify - :type 'string) + :type 'regexp) (defcustom tildify-space-predicates '(tildify-space-region-predicate) "A list of predicate functions for `tildify-space' function." diff --git a/lisp/thread.el b/lisp/thread.el index d40d7bed538..00a0084f81f 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -43,8 +43,6 @@ An EVENT has the format (err (cddr event))) (message "Error %s: %S" thread err)))) -(make-obsolete 'thread-alive-p 'thread-live-p "27.1") - ;;; The thread list buffer and list-threads command (defcustom thread-list-refresh-seconds 0.5 diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index 47964b081f4..f34ef810c4a 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -92,12 +92,19 @@ path components followed by `..' are removed, along with the `..' itself." (cond ((= (length url) 0) ; nil or empty string (url-recreate-url default)) - ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately + ((string-match url-nonrelative-link url) ; Fully-qualified URL, + ; return it immediately url) (t (let* ((urlobj (url-generic-parse-url url)) (inhibit-file-name-handlers t) - (expander (url-scheme-get-property (url-type default) 'expand-file-name))) + (expander (if (url-type default) + (url-scheme-get-property (url-type default) + 'expand-file-name) + ;; If neither the default nor the URL to be + ;; expanded have a protocol, then just use the + ;; identity expander as a fallback. + 'url-identity-expander))) (if (string-match "^//" url) (setq urlobj (url-generic-parse-url (concat (url-type default) ":" url)))) diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index bcb67431aa8..f16fc234025 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -191,7 +191,7 @@ linked Emacs under SunOS 4.x." proc (concat (mapconcat 'identity (append url-gateway-telnet-parameters (list host service)) " ") "\n")) - (url-wait-for-string "^\r*Escape character.*\r*\n+" proc) + (url-wait-for-string "^\r*Escape character.*\n+" proc) (delete-region (point-min) (match-end 0)) (process-send-string proc "\^]\n") (url-wait-for-string "^telnet" proc) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 82617b76a71..4e44eedb122 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -430,6 +430,8 @@ Should be one of: "Hook run after initializing the URL library." :group 'url :type 'hook) +(make-obsolete-variable 'url-load-hook + "use `with-eval-after-load' instead." "28.1") (defconst url-working-buffer " *url-work") diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index fb1f25b6c6d..cbd8c0d322c 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -452,6 +452,8 @@ For each buffer, the hooks are run with that buffer made current." "Hook run after Ediff is loaded. Can be used to change defaults." :type 'hook :group 'ediff-hook) +(make-obsolete-variable 'ediff-load-hook + "use `with-eval-after-load' instead." "28.1") (defcustom ediff-mode-hook nil "Hook run just after ediff-mode is set up in the control buffer. @@ -1282,7 +1284,7 @@ Do not start with `~/' or `~USERNAME/'." (defcustom ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]" "Regexp that matches characters that must be quoted with `\\' in shell command line. This default should work without changes." - :type 'string + :type 'regexp :group 'ediff) ;; needed to simulate frame-char-width in XEmacs. diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index cb0ae6ff6e1..f6af5a45550 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -119,7 +119,7 @@ patch. So, don't change these variables, unless the default doesn't work." (defcustom ediff-context-diff-label-regexp (let ((stuff "\\([^ \t\n]+\\)")) (concat "\\(" ; context diff 2-liner - "^\\*\\*\\* +" stuff "[^*]+[\t ]*\n--- +" stuff + "^\\*\\*\\* +" stuff "[^*]+\n--- +" stuff "\\|" ; unified format diff 2-liner "^--- +" stuff ".*\n\\+\\+\\+ +" stuff "\\)")) diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index a8af9ba37a2..5f8a4a86b15 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1540,10 +1540,10 @@ the width of the A/B/C windows." ;; hscrolling. (if (= last-command-event ?<) (lambda (arg) - (let ((prefix-arg arg)) + (let ((current-prefix-arg arg)) (call-interactively #'scroll-left))) (lambda (arg) - (let ((prefix-arg arg)) + (let ((current-prefix-arg arg)) (call-interactively #'scroll-right)))) ;; calculate argument to scroll-left/right ;; if there is an explicit argument diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index 466c621311f..dd56aec94a0 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -472,7 +472,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; Let's not get all worked up if the format changes a bit (cvs-match " *Working revision:.*$")) (cvs-or - (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" (head-rev 1)) + (cvs-match " *RCS Version:[ \t]*\\([0-9.]+\\).*$" (head-rev 1)) (cvs-match " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$" (head-rev 1)) (cvs-match " *Repository revision:.*")) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 5ae300bf09b..4a04c9365a5 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -746,7 +746,8 @@ the buffer contents as a comment." (defun vc-dispatcher-browsing () "Are we in a directory browser buffer?" - (derived-mode-p 'vc-dir-mode)) + (or (derived-mode-p 'vc-dir-mode) + (derived-mode-p 'dired-mode))) ;; These are unused. ;; (defun vc-dispatcher-in-fileset-p (fileset) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 61e6c642d1f..2caa287bce2 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -166,7 +166,7 @@ format string (which is passed to \"git log\" via the argument \"--pretty=tformat:FORMAT\"), REGEXP is a regular expression matching the resulting Git log output, and KEYWORDS is a list of `font-lock-keywords' for highlighting the Log View buffer." - :type '(list string string (repeat sexp)) + :type '(list string regexp (repeat sexp)) :version "24.1") (defcustom vc-git-commits-coding-system 'utf-8 diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index d00b69c0d08..40d75738063 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -182,7 +182,7 @@ is the \"--template\" argument string to pass to Mercurial, REGEXP is a regular expression matching the resulting Mercurial output, and KEYWORDS is a list of `font-lock-keywords' for highlighting the Log View buffer." - :type '(list string string (repeat sexp)) + :type '(list string regexp (repeat sexp)) :group 'vc-hg :version "24.5") diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index ec252b74d47..f7d651fac6f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1032,9 +1032,7 @@ BEWARE: this function may change the current buffer." ((derived-mode-p 'vc-dir-mode) (vc-dir-deduce-fileset state-model-only-files)) ((derived-mode-p 'dired-mode) - (if observer - (vc-dired-deduce-fileset) - (error "State changing VC operations not supported in `dired-mode'"))) + (vc-dired-deduce-fileset state-model-only-files observer)) ((setq backend (vc-backend buffer-file-name)) (if state-model-only-files (list backend (list buffer-file-name) @@ -1046,7 +1044,8 @@ BEWARE: this function may change the current buffer." ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) (with-current-buffer vc-parent-buffer - (derived-mode-p 'vc-dir-mode)))) + (or (derived-mode-p 'vc-dir-mode) + (derived-mode-p 'dired-mode))))) (progn ;FIXME: Why not `with-current-buffer'? --Stef. (set-buffer vc-parent-buffer) (vc-deduce-fileset observer allow-unregistered state-model-only-files))) @@ -1066,9 +1065,31 @@ BEWARE: this function may change the current buffer." (list buffer-file-name)))) (t (error "File is not under version control"))))) -(defun vc-dired-deduce-fileset () - (list (vc-responsible-backend default-directory) - (dired-map-over-marks (dired-get-filename nil t) nil))) +(declare-function dired-get-marked-files "dired" + (&optional localp arg filter distinguish-one-marked error)) + +(defun vc-dired-deduce-fileset (&optional state-model-only-files observer) + (let ((backend (vc-responsible-backend default-directory)) + (files (dired-get-marked-files nil nil nil nil t)) + only-files-list + state + model) + (when (and (not observer) (cl-some #'file-directory-p files)) + (error "State changing VC operations on directories not supported in `dired-mode'")) + + (when state-model-only-files + (setq only-files-list (mapcar (lambda (file) (cons file (vc-state file))) files)) + (setq state (cdar only-files-list)) + ;; Check that all files are in a consistent state, since we use that + ;; state to decide which operation to perform. + (dolist (crt (cdr only-files-list)) + (unless (vc-compatible-state (cdr crt) state) + (error "When applying VC operations to multiple files, the files are required\nto be in similar VC states.\n%s in state %s clashes with %s in state %s" + (car crt) (cdr crt) (caar only-files-list) state))) + (setq only-files-list (mapcar 'car only-files-list)) + (when (and state (not (eq state 'unregistered))) + (setq model (vc-checkout-model backend only-files-list)))) + (list backend files only-files-list state model))) (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." diff --git a/lisp/wdired.el b/lisp/wdired.el index d91853e64dd..11cbe5822a7 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -640,6 +640,7 @@ Optional arguments are ignored." See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." (interactive "^p") + (setq this-command 'next-line) ;Let `line-move' preserve the column. (with-no-warnings (next-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement @@ -653,6 +654,7 @@ says how many lines to move; default is one line." See `wdired-use-dired-vertical-movement'. Optional prefix ARG says how many lines to move; default is one line." (interactive "^p") + (setq this-command 'previous-line) ;Let `line-move' preserve the column. (with-no-warnings (previous-line arg)) (if (or (eq wdired-use-dired-vertical-movement t) (and wdired-use-dired-vertical-movement diff --git a/lisp/whitespace.el b/lisp/whitespace.el index db7c023324b..0137ddcf04f 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -716,8 +716,8 @@ and the cons cdr is used for TABs visualization. Used when `whitespace-style' includes `indentation', `indentation::tab' or `indentation::space'." - :type '(cons (string :tag "Indentation SPACEs") - (string :tag "Indentation TABs")) + :type '(cons (regexp :tag "Indentation SPACEs") + (regexp :tag "Indentation TABs")) :group 'whitespace) @@ -747,8 +747,8 @@ and the cons cdr is used for TABs visualization. Used when `whitespace-style' includes `space-after-tab', `space-after-tab::tab' or `space-after-tab::space'." - :type '(cons (string :tag "SPACEs After TAB") - string) + :type '(cons (regexp :tag "SPACEs After TAB") + regexp) :group 'whitespace) (defcustom whitespace-big-indent-regexp diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 62846523be4..284fd1d6cbd 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -236,8 +236,7 @@ minibuffer." ;; Construct a menu of the choices ;; and then use it for prompting for a single character. (let* ((next-digit ?0) - (map (make-sparse-keymap)) - choice some-choice-enabled value) + alist choice some-choice-enabled value) (with-current-buffer (get-buffer-create " widget-choose") (erase-buffer) (insert "Available choices:\n\n") @@ -247,7 +246,7 @@ minibuffer." (let* ((name (substitute-command-keys (car choice))) (function (cdr choice))) (insert (format "%c = %s\n" next-digit name)) - (define-key map (vector next-digit) function) + (push (cons next-digit function) alist) (setq some-choice-enabled t))) ;; Allocate digits to disabled alternatives ;; so that the digit of a given alternative never varies. @@ -257,33 +256,17 @@ minibuffer." (forward-line)) (or some-choice-enabled (error "None of the choices is currently meaningful")) - (define-key map [?\M-\C-v] 'scroll-other-window) - (define-key map [?\M--] 'negative-argument) (save-window-excursion - (let ((buf (get-buffer " widget-choose"))) - (display-buffer buf - '(display-buffer-in-direction - (direction . bottom) - (window-height . fit-window-to-buffer))) - (let ((cursor-in-echo-area t) - (arg 1)) - (while (not value) - (setq value (lookup-key map (read-key-sequence (format "%s: " title)))) - (unless value - (user-error "Canceled")) - (when - (cond ((eq value 'scroll-other-window) - (let ((minibuffer-scroll-window - (get-buffer-window buf))) - (if (> 0 arg) - (scroll-other-window-down - (window-height minibuffer-scroll-window)) - (scroll-other-window)) - (setq arg 1))) - ((eq value 'negative-argument) - (setq arg -1))) - (setq value nil)))))) - value)))) + ;; Select window to be able to scroll it from minibuffer + (with-selected-window + (display-buffer (get-buffer " widget-choose") + '(display-buffer-in-direction + (direction . bottom) + (window-height . fit-window-to-buffer))) + (setq value (read-char-from-minibuffer + (format "%s: " title) + (mapcar #'car alist))))) + (cdr (assoc value alist)))))) ;;; Widget text specifications. ;; diff --git a/lisp/windmove.el b/lisp/windmove.el index 6e62e161548..40adb49e20f 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -467,18 +467,19 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (minibuffer-depth (minibuffer-depth)) (action (lambda (buffer alist) (unless (> (minibuffer-depth) minibuffer-depth) - (let ((window (cond - ((eq dir 'new-tab) - (let ((tab-bar-new-tab-choice t)) - (tab-bar-new-tab)) - (selected-window)) - ((eq dir 'same-window) - (selected-window)) - (t (window-in-direction - dir nil nil - (and arg (prefix-numeric-value arg)) - windmove-wrap-around)))) - (type 'reuse)) + (let* ((type 'reuse) + (window (cond + ((eq dir 'new-tab) + (let ((tab-bar-new-tab-choice t)) + (tab-bar-new-tab)) + (setq type 'tab) + (selected-window)) + ((eq dir 'same-window) + (selected-window)) + (t (window-in-direction + dir nil nil + (and arg (prefix-numeric-value arg)) + windmove-wrap-around))))) (unless window (setq window (split-window nil nil dir) type 'window)) (setq new-window (window--display-buffer buffer window diff --git a/lisp/window.el b/lisp/window.el index 40c4bf5ad47..bd825c09e16 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5009,6 +5009,13 @@ nil means to not handle the buffer in a particular way. This quad entry) (cond ((and (not prev-buffer) + (eq (nth 1 quit-restore) 'tab) + (eq (nth 3 quit-restore) buffer)) + (tab-bar-close-tab) + ;; If the previously selected window is still alive, select it. + (when (window-live-p (nth 2 quit-restore)) + (select-window (nth 2 quit-restore)))) + ((and (not prev-buffer) (or (eq (nth 1 quit-restore) 'frame) (and (eq (nth 1 quit-restore) 'window) ;; If the window has been created on an existing @@ -6367,7 +6374,12 @@ fourth element is BUFFER." ;; WINDOW has been created on a new frame. (set-window-parameter window 'quit-restore - (list 'frame 'frame (selected-window) buffer))))) + (list 'frame 'frame (selected-window) buffer))) + ((eq type 'tab) + ;; WINDOW has been created on a new tab. + (set-window-parameter + window 'quit-restore + (list 'tab 'tab (selected-window) buffer))))) (defcustom display-buffer-function nil "If non-nil, function to call to handle `display-buffer'. @@ -7034,7 +7046,7 @@ Return WINDOW if BUFFER and WINDOW are live." ;; use that. (display-buffer-mark-dedicated (set-window-dedicated-p window display-buffer-mark-dedicated)))) - (when (memq type '(window frame)) + (when (memq type '(window frame tab)) (set-window-prev-buffers window nil)) (let ((quit-restore (window-parameter window 'quit-restore)) (height (cdr (assq 'window-height alist))) diff --git a/lisp/woman.el b/lisp/woman.el index 8465ab7c32e..beebde95e9a 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -674,7 +674,7 @@ These normally have names of the form `man?'. Its default value is \"[Mm][Aa][Nn]\", which is case-insensitive mainly for the benefit of Microsoft platforms. Its purpose is to avoid `cat?', `.', `..', etc." ;; Based on a suggestion by Wei-Xue Shi. - :type 'string + :type 'regexp :group 'woman-interface) (defcustom woman-path @@ -753,7 +753,7 @@ Default is t." An alist with elements of the form (MENU-TITLE REGEXP INDEX) -- see the documentation for `imenu-generic-expression'." :type '(alist :key-type (choice :tag "Title" (const nil) string) - :value-type (group (choice (string :tag "Regexp") + :value-type (group (choice (regexp :tag "Regexp") function) integer)) :group 'woman-interface) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index ea9d119e2ff..b22af5cc770 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -412,19 +412,13 @@ FRAME is the frame and W is the window where the drop happened. If W is a window, return its absolute coordinates, otherwise return the frame coordinates." (let* ((frame-left (frame-parameter frame 'left)) - ;; If the frame is outside the display, frame-left looks like - ;; '(0 -16). Extract the -16. - (frame-real-left (if (consp frame-left) (car (cdr frame-left)) - frame-left)) - (frame-top (frame-parameter frame 'top)) - (frame-real-top (if (consp frame-top) (car (cdr frame-top)) - frame-top))) + (frame-top (frame-parameter frame 'top))) (if (windowp w) (let ((edges (window-inside-pixel-edges w))) (cons - (+ frame-real-left (nth 0 edges)) - (+ frame-real-top (nth 1 edges)))) - (cons frame-real-left frame-real-top)))) + (+ frame-left (nth 0 edges)) + (+ frame-top (nth 1 edges)))) + (cons frame-left frame-top)))) (declare-function x-get-atom-name "xselect.c" (value &optional frame)) (declare-function x-send-client-message "xselect.c" @@ -434,15 +428,11 @@ otherwise return the frame coordinates." (defun x-dnd-version-from-flags (flags) "Return the version byte from the 32 bit FLAGS in an XDndEnter message." - (if (consp flags) ;; Long as cons - (ash (car flags) -8) - (ash flags -24))) ;; Ordinary number + (ash flags -24)) (defun x-dnd-more-than-3-from-flags (flags) "Return the nmore-than3 bit from the 32 bit FLAGS in an XDndEnter message." - (if (consp flags) - (logand (cdr flags) 1) - (logand flags 1))) + (logand flags 1)) (defun x-dnd-handle-xdnd (event frame window message _format data) "Receive one XDND event (client message) and send the appropriate reply. @@ -454,7 +444,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (version (x-dnd-version-from-flags flags)) (more-than-3 (x-dnd-more-than-3-from-flags flags)) (dnd-source (aref data 0))) - (message "%s %s" version more-than-3) + (message "%s %s" version more-than-3) (if version ;; If flags is bad, version will be nil. (x-dnd-save-state window nil nil @@ -495,10 +485,12 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." ((equal "XdndDrop" message) (if (windowp window) (select-window window)) (let* ((dnd-source (aref data 0)) + (timestamp (aref data 2)) (value (and (x-dnd-current-type window) (x-get-selection-internal 'XdndSelection - (intern (x-dnd-current-type window))))) + (intern (x-dnd-current-type window)) + timestamp))) success action) (setq action (if value @@ -545,14 +537,14 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." ((eq size 4) (if (eq byteorder ?l) - (cons (+ (ash (aref data (+ 3 offset)) 8) - (aref data (+ 2 offset))) - (+ (ash (aref data (1+ offset)) 8) - (aref data offset))) - (cons (+ (ash (aref data offset) 8) - (aref data (1+ offset))) - (+ (ash (aref data (+ 2 offset)) 8) - (aref data (+ 3 offset)))))))) + (+ (ash (aref data (+ 3 offset)) 24) + (ash (aref data (+ 2 offset)) 16) + (ash (aref data (1+ offset)) 8) + (aref data offset)) + (+ (ash (aref data offset) 24) + (ash (aref data (1+ offset)) 16) + (ash (aref data (+ 2 offset)) 8) + (aref data (+ 3 offset))))))) (defun x-dnd-motif-value-to-list (value size byteorder) (let ((bytes (cond ((eq size 2) @@ -560,15 +552,10 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (logand value ?\xff))) ((eq size 4) - (if (consp value) - (list (logand (ash (car value) -8) ?\xff) - (logand (car value) ?\xff) - (logand (ash (cdr value) -8) ?\xff) - (logand (cdr value) ?\xff)) - (list (logand (ash value -24) ?\xff) - (logand (ash value -16) ?\xff) - (logand (ash value -8) ?\xff) - (logand value ?\xff))))))) + (list (logand (ash value -24) ?\xff) + (logand (ash value -16) ?\xff) + (logand (ash value -8) ?\xff) + (logand value ?\xff)))))) (if (eq byteorder ?l) (reverse bytes) bytes))) diff --git a/m4/00gnulib.m4 b/m4/00gnulib.m4 index 1a1a1d74f7e..06eff4f3863 100644 --- a/m4/00gnulib.m4 +++ b/m4/00gnulib.m4 @@ -1,13 +1,14 @@ -# 00gnulib.m4 serial 3 +# 00gnulib.m4 serial 7 dnl Copyright (C) 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. dnl This file must be named something that sorts before all other -dnl gnulib-provided .m4 files. It is needed until such time as we can -dnl assume Autoconf 2.64, with its improved AC_DEFUN_ONCE and -dnl m4_divert semantics. +dnl gnulib-provided .m4 files. The first part is needed until such time +dnl as we can assume Autoconf 2.64, with its improved AC_DEFUN_ONCE and +dnl m4_divert semantics. The second part is needed until the clang fix +dnl has been included in Autoconf. # Until autoconf 2.63, handling of the diversion stack required m4_init # to be called first; but this does not happen with aclocal. Wrapping @@ -39,6 +40,76 @@ m4_version_prereq([2.63.263], [], [m4_indir([_gl_DEFUN_ONCE([$1])])])])]dnl [AC][_DEFUN([_gl_DEFUN_ONCE([$1])], [$2])])]) +# The following definitions arrange to use a compiler option +# -Werror=implicit-function-declaration in AC_CHECK_DECL, when the +# compiler is clang. Without it, clang implicitly declares "known" +# library functions in C mode, but not in C++ mode, which would cause +# Gnulib to omit a declaration and thus later produce an error in C++ +# mode. As of clang 9.0, these "known" functions are identified through +# LIBBUILTIN invocations in the LLVM source file +# llvm/tools/clang/include/clang/Basic/Builtins.def. +# It's not possible to AC_REQUIRE the extra tests from AC_CHECK_DECL, +# because AC_CHECK_DECL, like other Autoconf built-ins, is not supposed +# to AC_REQUIRE anything: some configure.ac files have their first +# AC_CHECK_DECL executed conditionally. Therefore append the extra tests +# to AC_PROG_CC. +AC_DEFUN([gl_COMPILER_CLANG], +[ +dnl AC_REQUIRE([AC_PROG_CC]) + AC_CACHE_CHECK([whether the compiler is clang], + [gl_cv_compiler_clang], + [dnl Use _AC_COMPILE_IFELSE instead of AC_EGREP_CPP, to avoid error + dnl "circular dependency of AC_LANG_COMPILER(C)" if AC_PROG_CC has + dnl not yet been invoked. + _AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #ifdef __clang__ + barfbarf + #endif + ]],[[]]) + ], + [gl_cv_compiler_clang=no], + [gl_cv_compiler_clang=yes]) + ]) +]) +AC_DEFUN([gl_COMPILER_PREPARE_CHECK_DECL], +[ +dnl AC_REQUIRE([AC_PROG_CC]) +dnl AC_REQUIRE([gl_COMPILER_CLANG]) + AC_CACHE_CHECK([for compiler option needed when checking for declarations], + [gl_cv_compiler_check_decl_option], + [if test $gl_cv_compiler_clang = yes; then + dnl Test whether the compiler supports the option + dnl '-Werror=implicit-function-declaration'. + save_ac_compile="$ac_compile" + ac_compile="$ac_compile -Werror=implicit-function-declaration" + dnl Use _AC_COMPILE_IFELSE instead of AC_COMPILE_IFELSE, to avoid a + dnl warning "AC_COMPILE_IFELSE was called before AC_USE_SYSTEM_EXTENSIONS". + _AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]],[[]])], + [gl_cv_compiler_check_decl_option='-Werror=implicit-function-declaration'], + [gl_cv_compiler_check_decl_option=none]) + ac_compile="$save_ac_compile" + else + gl_cv_compiler_check_decl_option=none + fi + ]) + if test "x$gl_cv_compiler_check_decl_option" != xnone; then + ac_compile_for_check_decl="$ac_compile $gl_cv_compiler_check_decl_option" + else + ac_compile_for_check_decl="$ac_compile" + fi +]) +dnl Redefine _AC_CHECK_DECL_BODY so that it references ac_compile_for_check_decl +dnl instead of ac_compile. If, for whatever reason, the override of AC_PROG_CC +dnl in zzgnulib.m4 is inactive, use the original ac_compile. +m4_define([_AC_CHECK_DECL_BODY], +[ ac_save_ac_compile="$ac_compile" + if test -n "$ac_compile_for_check_decl"; then + ac_compile="$ac_compile_for_check_decl" + fi] +m4_defn([_AC_CHECK_DECL_BODY])[ ac_compile="$ac_save_ac_compile" +]) + # gl_00GNULIB # ----------- # Witness macro that this file has been included. Needed to force diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 5f4653967d1..59225245b91 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,6 +1,6 @@ # alloca.m4 serial 15 -dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/count-leading-zeros.m4 b/m4/count-leading-zeros.m4 deleted file mode 100644 index 76cc876f296..00000000000 --- a/m4/count-leading-zeros.m4 +++ /dev/null @@ -1,12 +0,0 @@ -# count-leading-zeros.m4 serial 2 -dnl Copyright (C) 2012-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_COUNT_LEADING_ZEROS], -[ - dnl We don't need (and can't compile) count_leading_zeros_ll - dnl unless the type 'unsigned long long int' exists. - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) -]) diff --git a/m4/count-one-bits.m4 b/m4/count-one-bits.m4 deleted file mode 100644 index 132d52761f0..00000000000 --- a/m4/count-one-bits.m4 +++ /dev/null @@ -1,12 +0,0 @@ -# count-one-bits.m4 serial 3 -dnl Copyright (C) 2007, 2009-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_COUNT_ONE_BITS], -[ - dnl We don't need (and can't compile) count_one_bits_ll - dnl unless the type 'unsigned long long int' exists. - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) -]) diff --git a/m4/count-trailing-zeros.m4 b/m4/count-trailing-zeros.m4 deleted file mode 100644 index 0344c8ffa50..00000000000 --- a/m4/count-trailing-zeros.m4 +++ /dev/null @@ -1,12 +0,0 @@ -# count-trailing-zeros.m4 -dnl Copyright (C) 2013-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_COUNT_TRAILING_ZEROS], -[ - dnl We don't need (and can't compile) count_trailing_zeros_ll - dnl unless the type 'unsigned long long int' exists. - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) -]) diff --git a/m4/d-type.m4 b/m4/d-type.m4 index bcb179ad4e1..d40220a1b59 100644 --- a/m4/d-type.m4 +++ b/m4/d-type.m4 @@ -5,8 +5,7 @@ dnl dnl Check whether struct dirent has a member named d_type. dnl -# Copyright (C) 1997, 1999-2004, 2006, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 1997, 1999-2004, 2006, 2009-2020 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/dup2.m4 b/m4/dup2.m4 index 2835bb1cf99..21b1ecc26b8 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,6 +1,5 @@ #serial 25 -dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005, 2007, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/filemode.m4 b/m4/filemode.m4 index a1b7e105b59..5aaaa1a167d 100644 --- a/m4/filemode.m4 +++ b/m4/filemode.m4 @@ -1,6 +1,5 @@ # filemode.m4 serial 8 -dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index 64fcf5d290d..0bc62066aab 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,8 +1,7 @@ # serial 34 # Obtaining file system usage information. -# Copyright (C) 1997-1998, 2000-2001, 2003-2020 Free Software -# Foundation, Inc. +# Copyright (C) 1997-1998, 2000-2001, 2003-2020 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index 79436460f30..3e7e46f8672 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -3,8 +3,7 @@ dnl From Jim Meyering. dnl A wrapper around AC_FUNC_GETGROUPS. -# Copyright (C) 1996-1997, 1999-2004, 2008-2020 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2004, 2008-2020 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 index 74a116fd10d..3bd2a142e73 100644 --- a/m4/getloadavg.m4 +++ b/m4/getloadavg.m4 @@ -1,7 +1,7 @@ # Check for getloadavg. -# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2020 Free -# Software Foundation, Inc. +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2020 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/gettime.m4 b/m4/gettime.m4 index 6a1f9a4157d..e65455a2ff9 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,6 +1,5 @@ # gettime.m4 serial 9 -dnl Copyright (C) 2002, 2004-2006, 2009-2020 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004-2006, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 443c6f9309a..c72b3eacc63 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,7 +1,6 @@ # serial 27 -# Copyright (C) 2001-2003, 2005, 2007, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 2001-2003, 2005, 2007, 2009-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/glibc21.m4 b/m4/glibc21.m4 index 9197d3bf45f..ece484b5ae9 100644 --- a/m4/glibc21.m4 +++ b/m4/glibc21.m4 @@ -1,6 +1,6 @@ # glibc21.m4 serial 5 -dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2000-2002, 2004, 2008, 2010-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index b617eacff01..b4795c18aeb 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 46 +# gnulib-common.m4 serial 48 dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -12,6 +12,7 @@ AC_DEFUN([gl_COMMON], [ dnl Use AC_REQUIRE here, so that the code is expanded once only. AC_REQUIRE([gl_00GNULIB]) AC_REQUIRE([gl_COMMON_BODY]) + AC_REQUIRE([gl_ZZGNULIB]) ]) AC_DEFUN([gl_COMMON_BODY], [ AH_VERBATIM([_Noreturn], @@ -30,7 +31,10 @@ AC_DEFUN([gl_COMMON_BODY], [ # define _Noreturn [[noreturn]] # elif ((!defined __cplusplus || defined __clang__) \ && (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \ - || 4 < __GNUC__ + (7 <= __GNUC_MINOR__))) + || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \ + || (defined __apple_build_version__ \ + ? 6000000 <= __apple_build_version__ \ + : 3 < __clang_major__ + (5 <= __clang_minor__)))) /* _Noreturn works as-is. */ # elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C # define _Noreturn __attribute__ ((__noreturn__)) @@ -415,12 +419,13 @@ AC_DEFUN([AC_C_RESTRICT], nothing if this is not supported. Do not define if restrict is supported directly. */ #undef restrict -/* Work around a bug in Sun C++: it does not support _Restrict or - __restrict__, even though the corresponding Sun C compiler ends up with - "#define restrict _Restrict" or "#define restrict __restrict__" in the - previous line. Perhaps some future version of Sun C++ will work with - restrict; if so, hopefully it defines __RESTRICT like Sun C does. */ -#if defined __SUNPRO_CC && !defined __RESTRICT +/* Work around a bug in older versions of Sun C++, which did not + #define __restrict__ or support _Restrict or __restrict__ + even though the corresponding Sun C compiler ended up with + "#define restrict _Restrict" or "#define restrict __restrict__" + in the previous line. This workaround can be removed once + we assume Oracle Developer Studio 12.5 (2016) or later. */ +#if defined __SUNPRO_CC && !defined __RESTRICT && !defined __restrict__ # define _Restrict # define __restrict__ #endif]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index c952c9c956c..48d8030f539 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -133,7 +133,6 @@ AC_DEFUN([gl_EARLY], # Code from module pipe2: # Code from module pselect: # Code from module pthread_sigmask: - # Code from module putenv: # Code from module qcopy-acl: # Code from module readlink: # Code from module readlinkat: @@ -220,9 +219,6 @@ AC_DEFUN([gl_INIT], AC_LIBOBJ([copy-file-range]) fi gl_UNISTD_MODULE_INDICATOR([copy-file-range]) - gl_COUNT_LEADING_ZEROS - gl_COUNT_ONE_BITS - gl_COUNT_TRAILING_ZEROS gl_MD5 gl_SHA1 gl_SHA256 @@ -306,6 +302,7 @@ AC_DEFUN([gl_INIT], GNULIB_GL_UNISTD_H_GETOPT=1 fi AC_SUBST([GNULIB_GL_UNISTD_H_GETOPT]) + gl_UNISTD_MODULE_INDICATOR([getopt-posix]) gl_GETTIME gl_FUNC_GETTIMEOFDAY if test $HAVE_GETTIMEOFDAY = 0 || test $REPLACE_GETTIMEOFDAY = 1; then @@ -370,12 +367,6 @@ AC_DEFUN([gl_INIT], gl_PREREQ_PTHREAD_SIGMASK fi gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask]) - gl_FUNC_PUTENV - if test $REPLACE_PUTENV = 1; then - AC_LIBOBJ([putenv]) - gl_PREREQ_PUTENV - fi - gl_STDLIB_MODULE_INDICATOR([putenv]) gl_FUNC_READLINK if test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1; then AC_LIBOBJ([readlink]) @@ -484,7 +475,6 @@ AC_DEFUN([gl_INIT], func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b () { if ! $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then - AC_LIBOBJ([openat-proc]) gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true func_gl_gnulib_m4code_open fi @@ -976,7 +966,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/pipe2.c lib/pselect.c lib/pthread_sigmask.c - lib/putenv.c lib/qcopy-acl.c lib/readlink.c lib/readlinkat.c @@ -1050,9 +1039,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/canonicalize.m4 m4/clock_time.m4 m4/copy-file-range.m4 - m4/count-leading-zeros.m4 - m4/count-one-bits.m4 - m4/count-trailing-zeros.m4 m4/d-type.m4 m4/dirent_h.m4 m4/dirfd.m4 @@ -1094,7 +1080,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/largefile.m4 m4/limits-h.m4 m4/localtime-buffer.m4 - m4/longlong.m4 m4/lstat.m4 m4/malloca.m4 m4/manywarnings-c++.m4 @@ -1119,7 +1104,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/pipe2.m4 m4/pselect.m4 m4/pthread_sigmask.m4 - m4/putenv.m4 m4/readlink.m4 m4/readlinkat.m4 m4/regex.m4 @@ -1166,4 +1150,5 @@ AC_DEFUN([gl_FILE_LIST], [ m4/warnings.m4 m4/wchar_t.m4 m4/wint_t.m4 + m4/zzgnulib.m4 ]) diff --git a/m4/group-member.m4 b/m4/group-member.m4 index 5b32b5ff498..ad7368ceecb 100644 --- a/m4/group-member.m4 +++ b/m4/group-member.m4 @@ -1,7 +1,6 @@ # serial 14 -# Copyright (C) 1999-2001, 2003-2007, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 1999-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/inttypes.m4 b/m4/inttypes.m4 index e037be6fcc5..d0487d6368c 100644 --- a/m4/inttypes.m4 +++ b/m4/inttypes.m4 @@ -1,4 +1,4 @@ -# inttypes.m4 serial 27 +# inttypes.m4 serial 28 dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -113,10 +113,8 @@ AC_DEFUN([gl_INTTYPES_CHECK_LONG_LONG_INT_CONDITION], #if $2 #define CONDITION ($3) - #elif HAVE_LONG_LONG_INT - #define CONDITION ($4) #else - #define CONDITION 0 + #define CONDITION ($4) #endif int test[CONDITION ? 1 : -1];]])], [gl_cv_test_$1=yes], diff --git a/m4/largefile.m4 b/m4/largefile.m4 index f6863e46c49..e381339c40c 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 @@ -1,10 +1,27 @@ # Enable large files on systems where this is not the default. +# Enable support for files on Linux file systems with 64-bit inode numbers. # Copyright 1992-1996, 1998-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. +# The following macro works around a problem in Autoconf's AC_FUNC_FSEEKO: +# It does not set _LARGEFILE_SOURCE=1 on HP-UX/ia64 32-bit, although this +# setting of _LARGEFILE_SOURCE is needed so that <stdio.h> declares fseeko +# and ftello in C++ mode as well. +AC_DEFUN([gl_SET_LARGEFILE_SOURCE], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_FUNC_FSEEKO + case "$host_os" in + hpux*) + AC_DEFINE([_LARGEFILE_SOURCE], [1], + [Define to 1 to make fseeko visible on some hosts (e.g. glibc 2.2).]) + ;; + esac +]) + # The following implementation works around a problem in autoconf <= 2.69; # AC_SYS_LARGEFILE does not configure for large inodes on Mac OS X 10.5, # or configures them incorrectly in some cases. @@ -57,6 +74,9 @@ rm -rf conftest*[]dnl # one must use special compiler options to get large-file access to work. # For more details about this brain damage please see: # http://www.unix.org/version2/whatsnew/lfs20mar.html +# Additionally, on Linux file systems with 64-bit inodes a file that happens +# to have a 64-bit inode number cannot be accessed by 32-bit applications on +# Linux x86/x86_64. This can occur with file systems such as XFS and NFS. AC_DEFUN([AC_SYS_LARGEFILE], [AC_ARG_ENABLE(largefile, [ --disable-largefile omit support for large files]) diff --git a/m4/longlong.m4 b/m4/longlong.m4 deleted file mode 100644 index e878488ad54..00000000000 --- a/m4/longlong.m4 +++ /dev/null @@ -1,113 +0,0 @@ -# longlong.m4 serial 18 -dnl Copyright (C) 1999-2007, 2009-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Paul Eggert. - -AC_PREREQ([2.62]) - -# Define HAVE_LONG_LONG_INT if 'long long int' works. -# This can be faster than what's in Autoconf 2.62 through 2.68. - -# Note: If the type 'long long int' exists but is only 32 bits large -# (as on some very old compilers), HAVE_LONG_LONG_INT will not be -# defined. In this case you can treat 'long long int' like 'long int'. - -AC_DEFUN([AC_TYPE_LONG_LONG_INT], -[ - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) - AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int], - [ac_cv_type_long_long_int=yes - if test "x${ac_cv_prog_cc_c99-no}" = xno; then - ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int - if test $ac_cv_type_long_long_int = yes; then - dnl Catch a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004. - dnl If cross compiling, assume the bug is not important, since - dnl nobody cross compiles for this platform as far as we know. - AC_RUN_IFELSE( - [AC_LANG_PROGRAM( - [[@%:@include <limits.h> - @%:@ifndef LLONG_MAX - @%:@ define HALF \ - (1LL << (sizeof (long long int) * CHAR_BIT - 2)) - @%:@ define LLONG_MAX (HALF - 1 + HALF) - @%:@endif]], - [[long long int n = 1; - int i; - for (i = 0; ; i++) - { - long long int m = n << i; - if (m >> i != n) - return 1; - if (LLONG_MAX / 2 < m) - break; - } - return 0;]])], - [], - [ac_cv_type_long_long_int=no], - [:]) - fi - fi]) - if test $ac_cv_type_long_long_int = yes; then - AC_DEFINE([HAVE_LONG_LONG_INT], [1], - [Define to 1 if the system has the type 'long long int'.]) - fi -]) - -# Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. -# This can be faster than what's in Autoconf 2.62 through 2.68. - -# Note: If the type 'unsigned long long int' exists but is only 32 bits -# large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT -# will not be defined. In this case you can treat 'unsigned long long int' -# like 'unsigned long int'. - -AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT], -[ - AC_CACHE_CHECK([for unsigned long long int], - [ac_cv_type_unsigned_long_long_int], - [ac_cv_type_unsigned_long_long_int=yes - if test "x${ac_cv_prog_cc_c99-no}" = xno; then - AC_LINK_IFELSE( - [_AC_TYPE_LONG_LONG_SNIPPET], - [], - [ac_cv_type_unsigned_long_long_int=no]) - fi]) - if test $ac_cv_type_unsigned_long_long_int = yes; then - AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1], - [Define to 1 if the system has the type 'unsigned long long int'.]) - fi -]) - -# Expands to a C program that can be used to test for simultaneous support -# of 'long long' and 'unsigned long long'. We don't want to say that -# 'long long' is available if 'unsigned long long' is not, or vice versa, -# because too many programs rely on the symmetry between signed and unsigned -# integer types (excluding 'bool'). -AC_DEFUN([_AC_TYPE_LONG_LONG_SNIPPET], -[ - AC_LANG_PROGRAM( - [[/* For now, do not test the preprocessor; as of 2007 there are too many - implementations with broken preprocessors. Perhaps this can - be revisited in 2012. In the meantime, code should not expect - #if to work with literals wider than 32 bits. */ - /* Test literals. */ - long long int ll = 9223372036854775807ll; - long long int nll = -9223372036854775807LL; - unsigned long long int ull = 18446744073709551615ULL; - /* Test constant expressions. */ - typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) - ? 1 : -1)]; - typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 - ? 1 : -1)]; - int i = 63;]], - [[/* Test availability of runtime routines for shift and division. */ - long long int llmax = 9223372036854775807ll; - unsigned long long int ullmax = 18446744073709551615ull; - return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) - | (llmax / ll) | (llmax % ll) - | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) - | (ullmax / ull) | (ullmax % ull));]]) -]) diff --git a/m4/malloca.m4 b/m4/malloca.m4 index 99e9dace2c5..930199da14a 100644 --- a/m4/malloca.m4 +++ b/m4/malloca.m4 @@ -1,6 +1,6 @@ -# malloca.m4 serial 1 -dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software -dnl Foundation, Inc. +# malloca.m4 serial 2 +dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -11,5 +11,4 @@ AC_DEFUN([gl_MALLOCA], dnl @ALLOCA@ and @LTALLOCA@. dnl gl_FUNC_ALLOCA dnl Already brought in by the module dependencies. AC_REQUIRE([gl_EEMALLOC]) - AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) ]) diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4 index 63e4087784b..899f12a880a 100644 --- a/m4/mempcpy.m4 +++ b/m4/mempcpy.m4 @@ -1,6 +1,6 @@ # mempcpy.m4 serial 11 -dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2003-2004, 2006-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/memrchr.m4 b/m4/memrchr.m4 index 8e33fb96a07..95990ed6b76 100644 --- a/m4/memrchr.m4 +++ b/m4/memrchr.m4 @@ -1,6 +1,6 @@ # memrchr.m4 serial 10 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/mktime.m4 b/m4/mktime.m4 index 5e89f20e979..c00843f0f40 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,6 +1,6 @@ # serial 31 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index ec41d42f4ba..c15fab3e98b 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,7 +1,6 @@ # serial 34 -# Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 1996-1997, 1999-2007, 2009-2020 Free Software Foundation, Inc. # # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/pathmax.m4 b/m4/pathmax.m4 index dc6bc3bceba..bb4fdeba750 100644 --- a/m4/pathmax.m4 +++ b/m4/pathmax.m4 @@ -1,6 +1,6 @@ # pathmax.m4 serial 11 -dnl Copyright (C) 2002-2003, 2005-2006, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2006, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/putenv.m4 b/m4/putenv.m4 deleted file mode 100644 index e38f8c56940..00000000000 --- a/m4/putenv.m4 +++ /dev/null @@ -1,60 +0,0 @@ -# putenv.m4 serial 24 -dnl Copyright (C) 2002-2020 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Jim Meyering. -dnl -dnl Check whether putenv ("FOO") removes FOO from the environment. -dnl The putenv in libc on at least SunOS 4.1.4 does *not* do that. - -AC_DEFUN([gl_FUNC_PUTENV], -[ - AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) - AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - AC_CACHE_CHECK([for putenv compatible with GNU and SVID], - [gl_cv_func_svid_putenv], - [AC_RUN_IFELSE([AC_LANG_PROGRAM([AC_INCLUDES_DEFAULT],[[ - /* Put it in env. */ - if (putenv ("CONFTEST_putenv=val")) - return 1; - - /* Try to remove it. */ - if (putenv ("CONFTEST_putenv")) - return 2; - - /* Make sure it was deleted. */ - if (getenv ("CONFTEST_putenv") != 0) - return 3; - - return 0; - ]])], - gl_cv_func_svid_putenv=yes, - gl_cv_func_svid_putenv=no, - dnl When crosscompiling, assume putenv is broken. - [case "$host_os" in - # Guess yes on glibc systems. - *-gnu* | gnu*) gl_cv_func_svid_putenv="guessing yes" ;; - # Guess yes on musl systems. - *-musl*) gl_cv_func_svid_putenv="guessing yes" ;; - # Guess no on native Windows. - mingw*) gl_cv_func_svid_putenv="guessing no" ;; - # If we don't know, obey --enable-cross-guesses. - *) gl_cv_func_svid_putenv="$gl_cross_guess_normal" ;; - esac - ]) - ]) - case "$gl_cv_func_svid_putenv" in - *yes) ;; - *) - REPLACE_PUTENV=1 - ;; - esac -]) - -# Prerequisites of lib/putenv.c. -AC_DEFUN([gl_PREREQ_PUTENV], -[ - AC_CHECK_DECLS([_putenv]) -]) diff --git a/m4/sig2str.m4 b/m4/sig2str.m4 index c9b1a860a17..415290c4dee 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,6 +1,5 @@ # serial 7 -dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4 index b77032b47a3..6c0a588873c 100644 --- a/m4/ssize_t.m4 +++ b/m4/ssize_t.m4 @@ -1,6 +1,5 @@ # ssize_t.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2001-2003, 2006, 2010-2020 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2001-2003, 2006, 2010-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4 index 9c44ae73dc1..5dad161c3b2 100644 --- a/m4/st_dm_mode.m4 +++ b/m4/st_dm_mode.m4 @@ -1,7 +1,6 @@ # serial 6 -# Copyright (C) 1998-1999, 2001, 2009-2020 Free Software Foundation, -# Inc. +# Copyright (C) 1998-1999, 2001, 2009-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, # with or without modifications, as long as this notice is preserved. diff --git a/m4/stat-time.m4 b/m4/stat-time.m4 index 59bd29f91ac..0ac3f7272e3 100644 --- a/m4/stat-time.m4 +++ b/m4/stat-time.m4 @@ -1,7 +1,7 @@ # Checks for stat-related time functions. -# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2020 Free -# Software Foundation, Inc. +# Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2020 Free Software +# Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 3f75a18f32c..29ad826d8ea 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 53 +# stdint.m4 serial 54 dnl Copyright (C) 2001-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -17,21 +17,12 @@ AC_DEFUN_ONCE([gl_STDINT_H], AC_REQUIRE([gl_LIMITS_H]) AC_REQUIRE([gt_TYPE_WINT_T]) - dnl Check for long long int and unsigned long long int. - AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) - if test $ac_cv_type_long_long_int = yes; then - HAVE_LONG_LONG_INT=1 - else - HAVE_LONG_LONG_INT=0 - fi - AC_SUBST([HAVE_LONG_LONG_INT]) - AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) - if test $ac_cv_type_unsigned_long_long_int = yes; then - HAVE_UNSIGNED_LONG_LONG_INT=1 - else - HAVE_UNSIGNED_LONG_LONG_INT=0 - fi - AC_SUBST([HAVE_UNSIGNED_LONG_LONG_INT]) + dnl For backward compatibility. Some packages may still be testing these + dnl macros. + AC_DEFINE([HAVE_LONG_LONG_INT], [1], + [Define to 1 if the system has the type 'long long int'.]) + AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1], + [Define to 1 if the system has the type 'unsigned long long int'.]) dnl Check for <wchar.h>, in the same way as gl_WCHAR_H does. AC_CHECK_HEADERS_ONCE([wchar.h]) diff --git a/m4/strnlen.m4 b/m4/strnlen.m4 index 67d4eb05c03..71b8e1baffe 100644 --- a/m4/strnlen.m4 +++ b/m4/strnlen.m4 @@ -1,6 +1,6 @@ # strnlen.m4 serial 13 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2020 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index de97d75ce67..4958e3dcd50 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,6 +1,5 @@ -# strtoimax.m4 serial 15 -dnl Copyright (C) 2002-2004, 2006, 2009-2020 Free Software Foundation, -dnl Inc. +# strtoimax.m4 serial 16 +dnl Copyright (C) 2002-2004, 2006, 2009-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -86,5 +85,4 @@ int main () # Prerequisites of lib/strtoimax.c. AC_DEFUN([gl_PREREQ_STRTOIMAX], [ AC_CHECK_DECLS([strtoll]) - AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) ]) diff --git a/m4/strtoll.m4 b/m4/strtoll.m4 index af962836ec6..edcde3b5582 100644 --- a/m4/strtoll.m4 +++ b/m4/strtoll.m4 @@ -1,6 +1,5 @@ -# strtoll.m4 serial 7 -dnl Copyright (C) 2002, 2004, 2006, 2008-2020 Free Software Foundation, -dnl Inc. +# strtoll.m4 serial 8 +dnl Copyright (C) 2002, 2004, 2006, 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. @@ -8,14 +7,9 @@ dnl with or without modifications, as long as this notice is preserved. AC_DEFUN([gl_FUNC_STRTOLL], [ AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) - dnl We don't need (and can't compile) the replacement strtoll - dnl unless the type 'long long int' exists. - AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) - if test "$ac_cv_type_long_long_int" = yes; then - AC_CHECK_FUNCS([strtoll]) - if test $ac_cv_func_strtoll = no; then - HAVE_STRTOLL=0 - fi + AC_CHECK_FUNCS([strtoll]) + if test $ac_cv_func_strtoll = no; then + HAVE_STRTOLL=0 fi ]) diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 index d63df9ebffd..a5f35d46dd9 100644 --- a/m4/sys_stat_h.m4 +++ b/m4/sys_stat_h.m4 @@ -1,4 +1,4 @@ -# sys_stat_h.m4 serial 31 -*- Autoconf -*- +# sys_stat_h.m4 serial 32 -*- Autoconf -*- dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -88,9 +88,11 @@ AC_DEFUN([gl_SYS_STAT_H_DEFAULTS], HAVE_MKNOD=1; AC_SUBST([HAVE_MKNOD]) HAVE_MKNODAT=1; AC_SUBST([HAVE_MKNODAT]) HAVE_UTIMENSAT=1; AC_SUBST([HAVE_UTIMENSAT]) + REPLACE_FCHMODAT=0; AC_SUBST([REPLACE_FCHMODAT]) REPLACE_FSTAT=0; AC_SUBST([REPLACE_FSTAT]) REPLACE_FSTATAT=0; AC_SUBST([REPLACE_FSTATAT]) REPLACE_FUTIMENS=0; AC_SUBST([REPLACE_FUTIMENS]) + REPLACE_LCHMOD=0; AC_SUBST([REPLACE_LCHMOD]) REPLACE_LSTAT=0; AC_SUBST([REPLACE_LSTAT]) REPLACE_MKDIR=0; AC_SUBST([REPLACE_MKDIR]) REPLACE_MKFIFO=0; AC_SUBST([REPLACE_MKFIFO]) diff --git a/m4/time_h.m4 b/m4/time_h.m4 index e4fe59084f8..aae0ae22741 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -1,7 +1,6 @@ # Configure a more-standard replacement for <time.h>. -# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc. # serial 11 diff --git a/m4/timespec.m4 b/m4/timespec.m4 index 5ed82b109c6..e71628dc318 100644 --- a/m4/timespec.m4 +++ b/m4/timespec.m4 @@ -1,7 +1,6 @@ #serial 15 -# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software -# Foundation, Inc. +# Copyright (C) 2000-2001, 2003-2007, 2009-2020 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation # gives unlimited permission to copy and/or distribute it, diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4 index 7453866df84..ea2bb016dbb 100644 --- a/m4/unistd_h.m4 +++ b/m4/unistd_h.m4 @@ -1,4 +1,4 @@ -# unistd_h.m4 serial 76 +# unistd_h.m4 serial 77 dnl Copyright (C) 2006-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -84,6 +84,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS], GNULIB_GETHOSTNAME=0; AC_SUBST([GNULIB_GETHOSTNAME]) GNULIB_GETLOGIN=0; AC_SUBST([GNULIB_GETLOGIN]) GNULIB_GETLOGIN_R=0; AC_SUBST([GNULIB_GETLOGIN_R]) + GNULIB_GETOPT_POSIX=0; AC_SUBST([GNULIB_GETOPT_POSIX]) GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE]) GNULIB_GETPASS=0; AC_SUBST([GNULIB_GETPASS]) GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL]) diff --git a/m4/zzgnulib.m4 b/m4/zzgnulib.m4 new file mode 100644 index 00000000000..98fa68f51a6 --- /dev/null +++ b/m4/zzgnulib.m4 @@ -0,0 +1,23 @@ +# zzgnulib.m4 serial 1 +dnl Copyright (C) 2020 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl This file must be named something that sorts after all other +dnl package- or gnulib-provided .m4 files - at least for those packages +dnl that redefine AC_PROG_CC. + +dnl Redefine AC_PROG_CC so that it ends with invocations of gl_COMPILER_CLANG +dnl and gl_COMPILER_PREPARE_CHECK_DECL. +m4_define([AC_PROG_CC], + m4_defn([AC_PROG_CC])[ +gl_COMPILER_CLANG +gl_COMPILER_PREPARE_CHECK_DECL +]) + +# gl_ZZGNULIB +# ----------- +# Witness macro that this file has been included. Needed to force +# Automake to include this file after all other gnulib .m4 files. +AC_DEFUN([gl_ZZGNULIB]) diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index d6a78ce58a2..e79dc4600c1 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ -/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "27.0.60"/ +/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "28.0.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index 31f4fd76c8f..9c8d20472a9 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2020 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 27.0.60 for MS-Windows + Emacs version 28.0.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 4693900f2dc..1cce2c3062f 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -499,6 +499,8 @@ extern void *malloc_after_dump_9x(size_t); extern void *realloc_after_dump_9x(void *, size_t); extern void free_after_dump_9x(void *); +extern void *sys_calloc(size_t, size_t); + extern malloc_fn the_malloc_fn; extern realloc_fn the_realloc_fn; extern free_fn the_free_fn; @@ -506,6 +508,7 @@ extern free_fn the_free_fn; #define malloc(size) (*the_malloc_fn)(size) #define free(ptr) (*the_free_fn)(ptr) #define realloc(ptr, size) (*the_realloc_fn)(ptr, size) +#define calloc(num, size) sys_calloc(num, size) #endif diff --git a/src/Makefile.in b/src/Makefile.in index ab63b926272..552dd2e50ae 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -295,8 +295,8 @@ EMACSRES = @EMACSRES@ W32_RES_LINK=@W32_RES_LINK@ ## Empty if !HAVE_X_WINDOWS -## xfont.o ftfont.o xftfont.o ftxfont.o if HAVE_XFT -## xfont.o ftfont.o ftxfont.o if HAVE_FREETYPE +## xfont.o ftfont.o xftfont.o if HAVE_XFT +## xfont.o ftfont.o if HAVE_FREETYPE ## xfont.o ftfont.o ftcrfont.o if USE_CAIRO ## else xfont.o ## if HAVE_HARFBUZZ, hbfont.o is added regardless of the rest @@ -436,7 +436,7 @@ SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ nsterm.o nsfns.o nsmenu.o nsselect.o nsimage.o nsfont.o macfont.o \ w32.o w32console.o w32cygwinx.o w32fns.o w32heap.o w32inevt.o w32notify.o \ w32menu.o w32proc.o w32reg.o w32select.o w32term.o w32xfns.o \ - w16select.o widget.o xfont.o ftfont.o xftfont.o ftxfont.o gtkutil.o \ + w16select.o widget.o xfont.o ftfont.o xftfont.o gtkutil.o \ xsettings.o xgselect.o termcap.o hbfont.o ## gmalloc.o if !SYSTEM_MALLOC && !DOUG_LEA_MALLOC, else empty. diff --git a/src/alloc.c b/src/alloc.c index 1c6b664b220..a35b48cfb22 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -104,6 +104,26 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "w32heap.h" /* for sbrk */ #endif +/* MALLOC_SIZE_NEAR (N) is a good number to pass to malloc when + allocating a block of memory with size close to N bytes. + For best results N should be a power of 2. + + When calculating how much memory to allocate, GNU malloc (SIZE) + adds sizeof (size_t) to SIZE for internal overhead, and then rounds + up to a multiple of MALLOC_ALIGNMENT. Emacs can improve + performance a bit on GNU platforms by arranging for the resulting + size to be a power of two. This heuristic is good for glibc 2.0 + (1997) through at least glibc 2.31 (2020), and does not affect + correctness on other platforms. */ + +#define MALLOC_SIZE_NEAR(n) \ + (ROUNDUP (max (n, sizeof (size_t)), MALLOC_ALIGNMENT) - sizeof (size_t)) +#ifdef __i386 +enum { MALLOC_ALIGNMENT = 16 }; +#else +enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) }; +#endif + #ifdef DOUG_LEA_MALLOC /* Specify maximum number of areas to mmap. It would be nice to use a @@ -694,7 +714,7 @@ malloc_unblock_input (void) malloc_probe (size); \ } while (0) -static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1)); +static void *lmalloc (size_t, bool) ATTRIBUTE_MALLOC_SIZE ((1)); static void *lrealloc (void *, size_t); /* Like malloc but check for no memory and block interrupt input. */ @@ -705,7 +725,7 @@ xmalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size); + val = lmalloc (size, false); MALLOC_UNBLOCK_INPUT; if (!val && size) @@ -722,12 +742,11 @@ xzalloc (size_t size) void *val; MALLOC_BLOCK_INPUT; - val = lmalloc (size); + val = lmalloc (size, true); MALLOC_UNBLOCK_INPUT; if (!val && size) memory_full (size); - memset (val, 0, size); MALLOC_PROBE (size); return val; } @@ -743,7 +762,7 @@ xrealloc (void *block, size_t size) /* We must call malloc explicitly when BLOCK is 0, since some reallocs don't do this. */ if (! block) - val = lmalloc (size); + val = lmalloc (size, false); else val = lrealloc (block, size); MALLOC_UNBLOCK_INPUT; @@ -939,7 +958,7 @@ void *lisp_malloc_loser EXTERNALLY_VISIBLE; #endif static void * -lisp_malloc (size_t nbytes, enum mem_type type) +lisp_malloc (size_t nbytes, bool clearit, enum mem_type type) { register void *val; @@ -949,7 +968,7 @@ lisp_malloc (size_t nbytes, enum mem_type type) allocated_mem_type = type; #endif - val = lmalloc (nbytes); + val = lmalloc (nbytes, clearit); #if ! USE_LSB_TAG /* If the memory just allocated cannot be addressed thru a Lisp @@ -1290,16 +1309,21 @@ laligned (void *p, size_t size) that's never really exercised) for little benefit. */ static void * -lmalloc (size_t size) +lmalloc (size_t size, bool clearit) { #ifdef USE_ALIGNED_ALLOC if (! MALLOC_IS_LISP_ALIGNED && size % LISP_ALIGNMENT == 0) - return aligned_alloc (LISP_ALIGNMENT, size); + { + void *p = aligned_alloc (LISP_ALIGNMENT, size); + if (clearit && p) + memclear (p, size); + return p; + } #endif while (true) { - void *p = malloc (size); + void *p = clearit ? calloc (1, size) : malloc (size); if (laligned (p, size)) return p; free (p); @@ -1328,11 +1352,11 @@ lrealloc (void *p, size_t size) Interval Allocation ***********************************************************************/ -/* Number of intervals allocated in an interval_block structure. - The 1020 is 1024 minus malloc overhead. */ +/* Number of intervals allocated in an interval_block structure. */ -#define INTERVAL_BLOCK_SIZE \ - ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) +enum { INTERVAL_BLOCK_SIZE + = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct interval_block *)) + / sizeof (struct interval)) }; /* Intervals are allocated in chunks in the form of an interval_block structure. */ @@ -1377,7 +1401,7 @@ make_interval (void) if (interval_block_index == INTERVAL_BLOCK_SIZE) { struct interval_block *newi - = lisp_malloc (sizeof *newi, MEM_TYPE_NON_LISP); + = lisp_malloc (sizeof *newi, false, MEM_TYPE_NON_LISP); newi->next = interval_block; interval_block = newi; @@ -1444,10 +1468,9 @@ mark_interval_tree (INTERVAL i) longer used, can be easily recognized, and it's easy to compact the sblocks of small strings which we do in compact_small_strings. */ -/* Size in bytes of an sblock structure used for small strings. This - is 8192 minus malloc overhead. */ +/* Size in bytes of an sblock structure used for small strings. */ -#define SBLOCK_SIZE 8188 +enum { SBLOCK_SIZE = MALLOC_SIZE_NEAR (8192) }; /* Strings larger than this are considered large strings. String data for large strings is allocated from individual sblocks. */ @@ -1522,11 +1545,11 @@ struct sblock sdata data[FLEXIBLE_ARRAY_MEMBER]; }; -/* Number of Lisp strings in a string_block structure. The 1020 is - 1024 minus malloc overhead. */ +/* Number of Lisp strings in a string_block structure. */ -#define STRING_BLOCK_SIZE \ - ((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String)) +enum { STRING_BLOCK_SIZE + = ((MALLOC_SIZE_NEAR (1024) - sizeof (struct string_block *)) + / sizeof (struct Lisp_String)) }; /* Structure describing a block from which Lisp_String structures are allocated. */ @@ -1730,7 +1753,7 @@ allocate_string (void) add all the Lisp_Strings in it to the free-list. */ if (string_free_list == NULL) { - struct string_block *b = lisp_malloc (sizeof *b, MEM_TYPE_STRING); + struct string_block *b = lisp_malloc (sizeof *b, false, MEM_TYPE_STRING); int i; b->next = string_blocks; @@ -1778,15 +1801,16 @@ allocate_string (void) plus a NUL byte at the end. Allocate an sdata structure DATA for S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte - to NBYTES. Free S->u.s.data if it was initially non-null. */ + to NBYTES. Free S->u.s.data if it was initially non-null. -void + If CLEARIT, also clear the other bytes of S->u.s.data. */ + +static void allocate_string_data (struct Lisp_String *s, - EMACS_INT nchars, EMACS_INT nbytes) + EMACS_INT nchars, EMACS_INT nbytes, bool clearit) { - sdata *data, *old_data; + sdata *data; struct sblock *b; - ptrdiff_t old_nbytes; if (STRING_BYTES_MAX < nbytes) string_overflow (); @@ -1794,13 +1818,6 @@ allocate_string_data (struct Lisp_String *s, /* Determine the number of bytes needed to store NBYTES bytes of string data. */ ptrdiff_t needed = sdata_size (nbytes); - if (s->u.s.data) - { - old_data = SDATA_OF_STRING (s); - old_nbytes = STRING_BYTES (s); - } - else - old_data = NULL; MALLOC_BLOCK_INPUT; @@ -1813,7 +1830,7 @@ allocate_string_data (struct Lisp_String *s, mallopt (M_MMAP_MAX, 0); #endif - b = lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); + b = lisp_malloc (size + GC_STRING_EXTRA, clearit, MEM_TYPE_NON_LISP); #ifdef DOUG_LEA_MALLOC if (!mmap_lisp_allowed_p ()) @@ -1825,27 +1842,30 @@ allocate_string_data (struct Lisp_String *s, b->next_free = data; large_sblocks = b; } - else if (current_sblock == NULL - || (((char *) current_sblock + SBLOCK_SIZE - - (char *) current_sblock->next_free) - < (needed + GC_STRING_EXTRA))) - { - /* Not enough room in the current sblock. */ - b = lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); - data = b->data; - b->next = NULL; - b->next_free = data; - - if (current_sblock) - current_sblock->next = b; - else - oldest_sblock = b; - current_sblock = b; - } else { b = current_sblock; + + if (b == NULL + || (SBLOCK_SIZE - GC_STRING_EXTRA + < (char *) b->next_free - (char *) b + needed)) + { + /* Not enough room in the current sblock. */ + b = lisp_malloc (SBLOCK_SIZE, false, MEM_TYPE_NON_LISP); + data = b->data; + b->next = NULL; + b->next_free = data; + + if (current_sblock) + current_sblock->next = b; + else + oldest_sblock = b; + current_sblock = b; + } + data = b->next_free; + if (clearit) + memset (SDATA_DATA (data), 0, nbytes); } data->string = s; @@ -1866,16 +1886,55 @@ allocate_string_data (struct Lisp_String *s, GC_STRING_OVERRUN_COOKIE_SIZE); #endif - /* Note that Faset may call to this function when S has already data - assigned. In this case, mark data as free by setting it's string - back-pointer to null, and record the size of the data in it. */ - if (old_data) + tally_consing (needed); +} + +/* Reallocate multibyte STRING data when a single character is replaced. + The character is at byte offset CIDX_BYTE in the string. + The character being replaced is CLEN bytes long, + and the character that will replace it is NEW_CLEN bytes long. + Return the address of where the caller should store the + the new character. */ + +unsigned char * +resize_string_data (Lisp_Object string, ptrdiff_t cidx_byte, + int clen, int new_clen) +{ + eassume (STRING_MULTIBYTE (string)); + sdata *old_sdata = SDATA_OF_STRING (XSTRING (string)); + ptrdiff_t nchars = SCHARS (string); + ptrdiff_t nbytes = SBYTES (string); + ptrdiff_t new_nbytes = nbytes + (new_clen - clen); + unsigned char *data = SDATA (string); + unsigned char *new_charaddr; + + if (sdata_size (nbytes) == sdata_size (new_nbytes)) { - SDATA_NBYTES (old_data) = old_nbytes; - old_data->string = NULL; + /* No need to reallocate, as the size change falls within the + alignment slop. */ + XSTRING (string)->u.s.size_byte = new_nbytes; + new_charaddr = data + cidx_byte; + memmove (new_charaddr + new_clen, new_charaddr + clen, + nbytes - (cidx_byte + (clen - 1))); + } + else + { + allocate_string_data (XSTRING (string), nchars, new_nbytes, false); + unsigned char *new_data = SDATA (string); + new_charaddr = new_data + cidx_byte; + memcpy (new_charaddr + new_clen, data + cidx_byte + clen, + nbytes - (cidx_byte + clen)); + memcpy (new_data, data, cidx_byte); + + /* Mark old string data as free by setting its string back-pointer + to null, and record the size of the data in it. */ + SDATA_NBYTES (old_sdata) = nbytes; + old_sdata->string = NULL; } - tally_consing (needed); + clear_string_char_byte_cache (); + + return new_charaddr; } @@ -2110,6 +2169,9 @@ string_overflow (void) error ("Maximum string size exceeded"); } +static Lisp_Object make_clear_string (EMACS_INT, bool); +static Lisp_Object make_clear_multibyte_string (EMACS_INT, EMACS_INT, bool); + DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0, doc: /* Return a newly created string of length LENGTH, with INIT in each element. LENGTH must be an integer. @@ -2118,19 +2180,20 @@ If optional argument MULTIBYTE is non-nil, the result will be a multibyte string even if INIT is an ASCII character. */) (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte) { - register Lisp_Object val; - int c; + Lisp_Object val; EMACS_INT nbytes; CHECK_FIXNAT (length); CHECK_CHARACTER (init); - c = XFIXNAT (init); + int c = XFIXNAT (init); + bool clearit = !c; + if (ASCII_CHAR_P (c) && NILP (multibyte)) { nbytes = XFIXNUM (length); - val = make_uninit_string (nbytes); - if (nbytes) + val = make_clear_string (nbytes, clearit); + if (nbytes && !clearit) { memset (SDATA (val), c, nbytes); SDATA (val)[nbytes] = 0; @@ -2141,26 +2204,27 @@ a multibyte string even if INIT is an ASCII character. */) unsigned char str[MAX_MULTIBYTE_LENGTH]; ptrdiff_t len = CHAR_STRING (c, str); EMACS_INT string_len = XFIXNUM (length); - unsigned char *p, *beg, *end; if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) string_overflow (); - val = make_uninit_multibyte_string (string_len, nbytes); - for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len) + val = make_clear_multibyte_string (string_len, nbytes, clearit); + if (!clearit) { - /* First time we just copy `str' to the data of `val'. */ - if (p == beg) - memcpy (p, str, len); - else + unsigned char *beg = SDATA (val), *end = beg + nbytes; + for (unsigned char *p = beg; p < end; p += len) { - /* Next time we copy largest possible chunk from - initialized to uninitialized part of `val'. */ - len = min (p - beg, end - p); - memcpy (p, beg, len); + /* First time we just copy STR to the data of VAL. */ + if (p == beg) + memcpy (p, str, len); + else + { + /* Next time we copy largest possible chunk from + initialized to uninitialized part of VAL. */ + len = min (p - beg, end - p); + memcpy (p, beg, len); + } } } - if (nbytes) - *p = 0; } return val; @@ -2330,26 +2394,37 @@ make_specified_string (const char *contents, /* Return a unibyte Lisp_String set up to hold LENGTH characters - occupying LENGTH bytes. */ + occupying LENGTH bytes. If CLEARIT, clear its contents to null + bytes; otherwise, the contents are uninitialized. */ -Lisp_Object -make_uninit_string (EMACS_INT length) +static Lisp_Object +make_clear_string (EMACS_INT length, bool clearit) { Lisp_Object val; if (!length) return empty_unibyte_string; - val = make_uninit_multibyte_string (length, length); + val = make_clear_multibyte_string (length, length, clearit); STRING_SET_UNIBYTE (val); return val; } +/* Return a unibyte Lisp_String set up to hold LENGTH characters + occupying LENGTH bytes. */ + +Lisp_Object +make_uninit_string (EMACS_INT length) +{ + return make_clear_string (length, false); +} + /* Return a multibyte Lisp_String set up to hold NCHARS characters - which occupy NBYTES bytes. */ + which occupy NBYTES bytes. If CLEARIT, clear its contents to null + bytes; otherwise, the contents are uninitialized. */ -Lisp_Object -make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) +static Lisp_Object +make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit) { Lisp_Object string; struct Lisp_String *s; @@ -2361,12 +2436,21 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) s = allocate_string (); s->u.s.intervals = NULL; - allocate_string_data (s, nchars, nbytes); + allocate_string_data (s, nchars, nbytes, clearit); XSETSTRING (string, s); string_chars_consed += nbytes; return string; } +/* Return a multibyte Lisp_String set up to hold NCHARS characters + which occupy NBYTES bytes. */ + +Lisp_Object +make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) +{ + return make_clear_multibyte_string (nchars, nbytes, false); +} + /* Print arguments to BUF according to a FORMAT, then return a Lisp_String initialized with the data from BUF. */ @@ -3023,6 +3107,14 @@ cleanup_vector (struct Lisp_Vector *vector) if (uptr->finalizer) uptr->finalizer (uptr->p); } +#ifdef HAVE_MODULES + else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MODULE_FUNCTION)) + { + ATTRIBUTE_MAY_ALIAS struct Lisp_Module_Function *function + = (struct Lisp_Module_Function *) vector; + module_finalize_function (function); + } +#endif } /* Reclaim space used by unmarked vectors. */ @@ -3137,7 +3229,7 @@ sweep_vectors (void) at most VECTOR_ELTS_MAX. */ static struct Lisp_Vector * -allocate_vectorlike (ptrdiff_t len) +allocate_vectorlike (ptrdiff_t len, bool clearit) { eassert (0 < len && len <= VECTOR_ELTS_MAX); ptrdiff_t nbytes = header_size + len * word_size; @@ -3151,11 +3243,15 @@ allocate_vectorlike (ptrdiff_t len) #endif if (nbytes <= VBLOCK_BYTES_MAX) - p = allocate_vector_from_block (vroundup (nbytes)); + { + p = allocate_vector_from_block (vroundup (nbytes)); + if (clearit) + memclear (p, nbytes); + } else { struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes, - MEM_TYPE_VECTORLIKE); + clearit, MEM_TYPE_VECTORLIKE); lv->next = large_vectors; large_vectors = lv; p = large_vector_vec (lv); @@ -3178,20 +3274,37 @@ allocate_vectorlike (ptrdiff_t len) } -/* Allocate a vector with LEN slots. */ +/* Allocate a vector with LEN slots. If CLEARIT, clear its slots; + otherwise the vector's slots are uninitialized. */ -struct Lisp_Vector * -allocate_vector (ptrdiff_t len) +static struct Lisp_Vector * +allocate_clear_vector (ptrdiff_t len, bool clearit) { if (len == 0) return XVECTOR (zero_vector); if (VECTOR_ELTS_MAX < len) memory_full (SIZE_MAX); - struct Lisp_Vector *v = allocate_vectorlike (len); + struct Lisp_Vector *v = allocate_vectorlike (len, clearit); v->header.size = len; return v; } +/* Allocate a vector with LEN uninitialized slots. */ + +struct Lisp_Vector * +allocate_vector (ptrdiff_t len) +{ + return allocate_clear_vector (len, false); +} + +/* Allocate a vector with LEN nil slots. */ + +struct Lisp_Vector * +allocate_nil_vector (ptrdiff_t len) +{ + return allocate_clear_vector (len, true); +} + /* Allocate other vector-like structures. */ @@ -3208,7 +3321,7 @@ allocate_pseudovector (int memlen, int lisplen, eassert (lisplen <= size_max); eassert (memlen <= size_max + rest_max); - struct Lisp_Vector *v = allocate_vectorlike (memlen); + struct Lisp_Vector *v = allocate_vectorlike (memlen, false); /* Only the first LISPLEN slots will be traced normally by the GC. */ memclear (v->contents, zerolen * word_size); XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen); @@ -3218,7 +3331,7 @@ allocate_pseudovector (int memlen, int lisplen, struct buffer * allocate_buffer (void) { - struct buffer *b = lisp_malloc (sizeof *b, MEM_TYPE_BUFFER); + struct buffer *b = lisp_malloc (sizeof *b, false, MEM_TYPE_BUFFER); BUFFER_PVEC_INIT (b); /* Put B on the chain of all buffers including killed ones. */ @@ -3238,7 +3351,7 @@ allocate_record (EMACS_INT count) if (count > PSEUDOVECTOR_SIZE_MASK) error ("Attempt to allocate a record of %"pI"d slots; max is %d", count, PSEUDOVECTOR_SIZE_MASK); - struct Lisp_Vector *p = allocate_vectorlike (count); + struct Lisp_Vector *p = allocate_vectorlike (count, false); p->header.size = count; XSETPVECTYPE (p, PVEC_RECORD); return p; @@ -3291,9 +3404,11 @@ See also the function `vector'. */) Lisp_Object make_vector (ptrdiff_t length, Lisp_Object init) { - struct Lisp_Vector *p = allocate_vector (length); - for (ptrdiff_t i = 0; i < length; i++) - p->contents[i] = init; + bool clearit = NIL_IS_ZERO && NILP (init); + struct Lisp_Vector *p = allocate_clear_vector (length, clearit); + if (!clearit) + for (ptrdiff_t i = 0; i < length; i++) + p->contents[i] = init; return make_lisp_ptr (p, Lisp_Vectorlike); } @@ -3442,7 +3557,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_block_index == SYMBOL_BLOCK_SIZE) { struct symbol_block *new - = lisp_malloc (sizeof *new, MEM_TYPE_SYMBOL); + = lisp_malloc (sizeof *new, false, MEM_TYPE_SYMBOL); new->next = symbol_block; symbol_block = new; symbol_block_index = 0; @@ -3904,10 +4019,10 @@ refill_memory_reserve (void) MEM_TYPE_SPARE); if (spare_memory[5] == 0) spare_memory[5] = lisp_malloc (sizeof (struct string_block), - MEM_TYPE_SPARE); + false, MEM_TYPE_SPARE); if (spare_memory[6] == 0) spare_memory[6] = lisp_malloc (sizeof (struct string_block), - MEM_TYPE_SPARE); + false, MEM_TYPE_SPARE); if (spare_memory[0] && spare_memory[1] && spare_memory[5]) Vmemory_full = Qnil; #endif diff --git a/src/buffer.c b/src/buffer.c index 5c65d4d4d19..cc7d4e4817c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -6247,6 +6247,9 @@ Values are interpreted as follows: t use the cursor specified for the frame nil don't display a cursor box display a filled box cursor + (box . SIZE) display a filled box cursor, but make it + hollow if cursor is under masked image larger than + SIZE pixels in either dimension. hollow display a hollow box cursor bar display a vertical bar cursor with default width (bar . WIDTH) display a vertical bar cursor with width WIDTH diff --git a/src/bytecode.c b/src/bytecode.c index 9e75c9012e0..4624379756d 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -220,10 +220,10 @@ DEFINE (Bdup, 0211) \ DEFINE (Bsave_excursion, 0212) \ DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1. */ \ DEFINE (Bsave_restriction, 0214) \ -DEFINE (Bcatch, 0215) \ +DEFINE (Bcatch, 0215) /* Obsolete since Emacs-25. */ \ \ DEFINE (Bunwind_protect, 0216) \ -DEFINE (Bcondition_case, 0217) \ +DEFINE (Bcondition_case, 0217) /* Obsolete since Emacs-25. */ \ DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1. */ \ DEFINE (Btemp_output_buffer_show, 0221) /* Obsolete since Emacs-24.1. */ \ \ @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_restriction_save ()); NEXT; - CASE (Bcatch): /* Obsolete since 24.4. */ + CASE (Bcatch): /* Obsolete since 25. */ { Lisp_Object v1 = POP; TOP = internal_catch (TOP, eval_sub, v1); @@ -807,7 +807,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; } - CASE (Bcondition_case): /* Obsolete since 24.4. */ + CASE (Bcondition_case): /* Obsolete since 25. */ { Lisp_Object handlers = POP, body = POP; TOP = internal_lisp_condition_case (TOP, body, handlers); diff --git a/src/coding.c b/src/coding.c index ed755b1afcf..8b54281c0bf 100644 --- a/src/coding.c +++ b/src/coding.c @@ -11745,6 +11745,8 @@ syms_of_coding (void) DEFSYM (Qignored, "ignored"); + DEFSYM (Qutf_8_string_p, "utf-8-string-p"); + defsubr (&Scoding_system_p); defsubr (&Sread_coding_system); defsubr (&Sread_non_nil_coding_system); diff --git a/src/composite.c b/src/composite.c index 53e6930b5f2..05365cfb65e 100644 --- a/src/composite.c +++ b/src/composite.c @@ -1746,7 +1746,18 @@ should be ignored. */) CHECK_STRING (string); validate_subarray (string, from, to, SCHARS (string), &frompos, &topos); if (! STRING_MULTIBYTE (string)) - error ("Attempt to shape unibyte text"); + { + ptrdiff_t i; + + for (i = SBYTES (string) - 1; i >= 0; i--) + if (!ASCII_CHAR_P (SREF (string, i))) + error ("Attempt to shape unibyte text"); + /* STRING is a pure-ASCII string, so we can convert it (or, + rather, its copy) to multibyte and use that thereafter. */ + Lisp_Object string_copy = Fconcat (1, &string); + STRING_SET_MULTIBYTE (string_copy); + string = string_copy; + } frombyte = string_char_to_byte (string, frompos); } diff --git a/src/data.c b/src/data.c index b1530688468..fae9cee7db1 100644 --- a/src/data.c +++ b/src/data.c @@ -2293,61 +2293,45 @@ bool-vector. IDX starts at 0. */) } else /* STRINGP */ { - int c; - CHECK_IMPURE (array, XSTRING (array)); if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); - c = XFIXNAT (newelt); + int c = XFIXNAT (newelt); + ptrdiff_t idxval_byte; + int prev_bytes; + unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; if (STRING_MULTIBYTE (array)) { - ptrdiff_t idxval_byte, nbytes; - int prev_bytes, new_bytes; - unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; - - nbytes = SBYTES (array); idxval_byte = string_char_to_byte (array, idxval); p1 = SDATA (array) + idxval_byte; prev_bytes = BYTES_BY_CHAR_HEAD (*p1); - new_bytes = CHAR_STRING (c, p0); - if (prev_bytes != new_bytes) - { - /* We must relocate the string data. */ - ptrdiff_t nchars = SCHARS (array); - USE_SAFE_ALLOCA; - unsigned char *str = SAFE_ALLOCA (nbytes); - - memcpy (str, SDATA (array), nbytes); - allocate_string_data (XSTRING (array), nchars, - nbytes + new_bytes - prev_bytes); - memcpy (SDATA (array), str, idxval_byte); - p1 = SDATA (array) + idxval_byte; - memcpy (p1 + new_bytes, str + idxval_byte + prev_bytes, - nbytes - (idxval_byte + prev_bytes)); - SAFE_FREE (); - clear_string_char_byte_cache (); - } - while (new_bytes--) - *p1++ = *p0++; } - else + else if (SINGLE_BYTE_CHAR_P (c)) { - if (! SINGLE_BYTE_CHAR_P (c)) - { - ptrdiff_t i; - - for (i = SBYTES (array) - 1; i >= 0; i--) - if (SREF (array, i) >= 0x80) - args_out_of_range (array, newelt); - /* ARRAY is an ASCII string. Convert it to a multibyte - string, and try `aset' again. */ - STRING_SET_MULTIBYTE (array); - return Faset (array, idx, newelt); - } SSET (array, idxval, c); + return newelt; } + else + { + for (ptrdiff_t i = SBYTES (array) - 1; i >= 0; i--) + if (!ASCII_CHAR_P (SREF (array, i))) + args_out_of_range (array, newelt); + /* ARRAY is an ASCII string. Convert it to a multibyte string. */ + STRING_SET_MULTIBYTE (array); + idxval_byte = idxval; + p1 = SDATA (array) + idxval_byte; + prev_bytes = 1; + } + + int new_bytes = CHAR_STRING (c, p0); + if (prev_bytes != new_bytes) + p1 = resize_string_data (array, idxval_byte, prev_bytes, new_bytes); + + do + *p1++ = *p0++; + while (--new_bytes != 0); } return newelt; @@ -3310,27 +3294,14 @@ bool_vector_spare_mask (EMACS_INT nr_bits) return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1; } -/* Info about unsigned long long, falling back on unsigned long - if unsigned long long is not available. */ - -#if HAVE_UNSIGNED_LONG_LONG_INT && defined ULLONG_WIDTH -enum { ULL_WIDTH = ULLONG_WIDTH }; -# define ULL_MAX ULLONG_MAX -#else -enum { ULL_WIDTH = ULONG_WIDTH }; -# define ULL_MAX ULONG_MAX -# define count_one_bits_ll count_one_bits_l -# define count_trailing_zeros_ll count_trailing_zeros_l -#endif - /* Shift VAL right by the width of an unsigned long long. - ULL_WIDTH must be less than BITS_PER_BITS_WORD. */ + ULLONG_WIDTH must be less than BITS_PER_BITS_WORD. */ static bits_word shift_right_ull (bits_word w) { /* Pacify bogus GCC warning about shift count exceeding type width. */ - int shift = ULL_WIDTH - BITS_PER_BITS_WORD < 0 ? ULL_WIDTH : 0; + int shift = ULLONG_WIDTH - BITS_PER_BITS_WORD < 0 ? ULLONG_WIDTH : 0; return w >> shift; } @@ -3347,7 +3318,7 @@ count_one_bits_word (bits_word w) { int i = 0, count = 0; while (count += count_one_bits_ll (w), - (i += ULL_WIDTH) < BITS_PER_BITS_WORD) + (i += ULLONG_WIDTH) < BITS_PER_BITS_WORD) w = shift_right_ull (w); return count; } @@ -3478,7 +3449,7 @@ count_trailing_zero_bits (bits_word val) return count_trailing_zeros (val); if (BITS_WORD_MAX == ULONG_MAX) return count_trailing_zeros_l (val); - if (BITS_WORD_MAX == ULL_MAX) + if (BITS_WORD_MAX == ULLONG_MAX) return count_trailing_zeros_ll (val); /* The rest of this code is for the unlikely platform where bits_word differs @@ -3492,18 +3463,18 @@ count_trailing_zero_bits (bits_word val) { int count; for (count = 0; - count < BITS_PER_BITS_WORD - ULL_WIDTH; - count += ULL_WIDTH) + count < BITS_PER_BITS_WORD - ULLONG_WIDTH; + count += ULLONG_WIDTH) { - if (val & ULL_MAX) + if (val & ULLONG_MAX) return count + count_trailing_zeros_ll (val); val = shift_right_ull (val); } - if (BITS_PER_BITS_WORD % ULL_WIDTH != 0 + if (BITS_PER_BITS_WORD % ULLONG_WIDTH != 0 && BITS_WORD_MAX == (bits_word) -1) val |= (bits_word) 1 << pre_value (ULONG_MAX < BITS_WORD_MAX, - BITS_PER_BITS_WORD % ULL_WIDTH); + BITS_PER_BITS_WORD % ULLONG_WIDTH); return count + count_trailing_zeros_ll (val); } } @@ -3516,10 +3487,8 @@ bits_word_to_host_endian (bits_word val) #else if (BITS_WORD_MAX >> 31 == 1) return bswap_32 (val); -# if HAVE_UNSIGNED_LONG_LONG if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1) return bswap_64 (val); -# endif { int i; bits_word r = 0; diff --git a/src/deps.mk b/src/deps.mk index a7e1b559173..4d162eeb0f2 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -239,9 +239,6 @@ xfont.o: dispextern.h xterm.h frame.h blockinput.h character.h charset.h \ xftfont.o: xftfont.c dispextern.h xterm.h frame.h blockinput.h character.h \ charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \ fontset.h ccl.h ftfont.h composite.h -ftxfont.o: ftxfont.c dispextern.h xterm.h frame.h blockinput.h character.h \ - charset.h font.h lisp.h globals.h $(config_h) atimer.h systime.h \ - fontset.h ccl.h menu.o: menu.c lisp.h keyboard.h keymap.h frame.h termhooks.h blockinput.h \ dispextern.h $(srcdir)/../lwlib/lwlib.h xterm.h gtkutil.h menu.h \ lisp.h globals.h $(config_h) systime.h coding.h composite.h window.h \ diff --git a/src/dired.c b/src/dired.c index 611477aa4ef..f013a4cea03 100644 --- a/src/dired.c +++ b/src/dired.c @@ -937,7 +937,7 @@ file_attributes (int fd, char const *name, int err = EINVAL; #if defined O_PATH && !defined HAVE_CYGWIN_O_PATH_BUG - int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW); + int namefd = emacs_openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW, 0); if (namefd < 0) err = errno; else @@ -970,7 +970,7 @@ file_attributes (int fd, char const *name, information to be accurate. */ w32_stat_get_owner_group = 1; #endif - err = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; + err = emacs_fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0 ? 0 : errno; #ifdef WINDOWSNT w32_stat_get_owner_group = 0; #endif diff --git a/src/emacs-module.c b/src/emacs-module.c index d56d03203b1..60f16418efa 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -122,12 +122,6 @@ To add a new module function, proceed as follows: /* Function prototype for the module init function. */ typedef int (*emacs_init_function) (struct emacs_runtime *); -/* Function prototype for module user-pointer finalizers. These - should not throw C++ exceptions, so emacs-module.h declares the - corresponding interfaces with EMACS_NOEXCEPT. There is only C code - in this module, though, so this constraint is not enforced here. */ -typedef void (*emacs_finalizer_function) (void *); - /* Memory management. */ @@ -219,6 +213,25 @@ static bool value_storage_contains_p (const struct emacs_value_storage *, static bool module_assertions = false; + +/* Small helper functions. */ + +/* Interprets the string at STR with length LEN as UTF-8 string. + Signals an error if it's not a valid UTF-8 string. */ + +static Lisp_Object +module_decode_utf_8 (const char *str, ptrdiff_t len) +{ + /* We set HANDLE-8-BIT and HANDLE-OVER-UNI to nil to signal an error + if the argument is not a valid UTF-8 string. While it isn't + documented how make_string and make_function behave in this case, + signaling an error is the most defensive and obvious reaction. */ + Lisp_Object s = decode_string_utf_8 (Qnil, str, len, Qnil, false, Qnil, Qnil); + CHECK_TYPE (!NILP (s), Qutf_8_string_p, make_string_from_utf8 (str, len)); + return s; +} + + /* Convenience macros for non-local exit handling. */ /* FIXME: The following implementation for non-local exit handling @@ -333,6 +346,12 @@ static bool module_assertions = false; MODULE_HANDLE_NONLOCAL_EXIT (error_retval) static void +CHECK_MODULE_FUNCTION (Lisp_Object obj) +{ + CHECK_TYPE (MODULE_FUNCTIONP (obj), Qmodule_function_p, obj); +} + +static void CHECK_USER_PTR (Lisp_Object obj) { CHECK_TYPE (USER_PTRP (obj), Quser_ptrp, obj); @@ -343,11 +362,11 @@ CHECK_USER_PTR (Lisp_Object obj) the Emacs main thread. */ static emacs_env * -module_get_environment (struct emacs_runtime *ert) +module_get_environment (struct emacs_runtime *runtime) { module_assert_thread (); - module_assert_runtime (ert); - return ert->private_members->env; + module_assert_runtime (runtime); + return runtime->private_members->env; } /* To make global refs (GC-protected global values) keep a hash that @@ -356,11 +375,11 @@ module_get_environment (struct emacs_runtime *ert) static Lisp_Object Vmodule_refs_hash; static emacs_value -module_make_global_ref (emacs_env *env, emacs_value ref) +module_make_global_ref (emacs_env *env, emacs_value value) { MODULE_FUNCTION_BEGIN (NULL); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object new_obj = value_to_lisp (ref), hashcode; + Lisp_Object new_obj = value_to_lisp (value), hashcode; ptrdiff_t i = hash_lookup (h, new_obj, &hashcode); if (i >= 0) @@ -381,14 +400,14 @@ module_make_global_ref (emacs_env *env, emacs_value ref) } static void -module_free_global_ref (emacs_env *env, emacs_value ref) +module_free_global_ref (emacs_env *env, emacs_value global_value) { /* TODO: This probably never signals. */ /* FIXME: Wait a minute. Shouldn't this function report an error if the hash lookup fails? */ MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); - Lisp_Object obj = value_to_lisp (ref); + Lisp_Object obj = value_to_lisp (global_value); ptrdiff_t i = hash_lookup (h, obj, NULL); if (i >= 0) @@ -406,7 +425,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) if (module_assertions) { ptrdiff_t count = 0; - if (value_storage_contains_p (&global_storage, ref, &count)) + if (value_storage_contains_p (&global_storage, global_value, &count)) return; module_abort ("Global value was not found in list of %"pD"d globals", count); @@ -430,14 +449,15 @@ module_non_local_exit_clear (emacs_env *env) } static enum emacs_funcall_exit -module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) +module_non_local_exit_get (emacs_env *env, + emacs_value *symbol, emacs_value *data) { module_assert_thread (); module_assert_env (env); struct emacs_env_private *p = env->private_members; if (p->pending_non_local_exit != emacs_funcall_exit_return) { - *sym = &p->non_local_exit_symbol; + *symbol = &p->non_local_exit_symbol; *data = &p->non_local_exit_data; } return p->pending_non_local_exit; @@ -445,12 +465,13 @@ module_non_local_exit_get (emacs_env *env, emacs_value *sym, emacs_value *data) /* Like for `signal', DATA must be a list. */ static void -module_non_local_exit_signal (emacs_env *env, emacs_value sym, emacs_value data) +module_non_local_exit_signal (emacs_env *env, + emacs_value symbol, emacs_value data) { module_assert_thread (); module_assert_env (env); if (module_non_local_exit_check (env) == emacs_funcall_exit_return) - module_non_local_exit_signal_1 (env, value_to_lisp (sym), + module_non_local_exit_signal_1 (env, value_to_lisp (symbol), value_to_lisp (data)); } @@ -464,10 +485,6 @@ module_non_local_exit_throw (emacs_env *env, emacs_value tag, emacs_value value) value_to_lisp (value)); } -/* Function prototype for the module Lisp functions. */ -typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, - emacs_value [], void *); - /* Module function. */ /* A function environment is an auxiliary structure returned by @@ -484,8 +501,9 @@ struct Lisp_Module_Function /* Fields ignored by GC. */ ptrdiff_t min_arity, max_arity; - emacs_subr subr; + emacs_function subr; void *data; + emacs_finalizer finalizer; } GCALIGNED_STRUCT; static struct Lisp_Module_Function * @@ -503,8 +521,7 @@ allocate_module_function (void) static emacs_value module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_subr subr, const char *documentation, - void *data) + emacs_function func, const char *docstring, void *data) { MODULE_FUNCTION_BEGIN (NULL); @@ -518,11 +535,13 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, struct Lisp_Module_Function *function = allocate_module_function (); function->min_arity = min_arity; function->max_arity = max_arity; - function->subr = subr; + function->subr = func; function->data = data; + function->finalizer = NULL; - if (documentation) - function->documentation = build_string_from_utf8 (documentation); + if (docstring) + function->documentation + = module_decode_utf_8 (docstring, strlen (docstring)); Lisp_Object result; XSET_MODULE_FUNCTION (result, function); @@ -531,9 +550,35 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, return lisp_to_value (env, result); } +static emacs_finalizer +module_get_function_finalizer (emacs_env *env, emacs_value arg) +{ + MODULE_FUNCTION_BEGIN (NULL); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_MODULE_FUNCTION (lisp); + return XMODULE_FUNCTION (lisp)->finalizer; +} + +static void +module_set_function_finalizer (emacs_env *env, emacs_value arg, + emacs_finalizer fin) +{ + MODULE_FUNCTION_BEGIN (); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_MODULE_FUNCTION (lisp); + XMODULE_FUNCTION (lisp)->finalizer = fin; +} + +void +module_finalize_function (const struct Lisp_Module_Function *func) +{ + if (func->finalizer != NULL) + func->finalizer (func->data); +} + static emacs_value -module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, - emacs_value args[]) +module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, + emacs_value *args) { MODULE_FUNCTION_BEGIN (NULL); @@ -545,7 +590,7 @@ module_funcall (emacs_env *env, emacs_value fun, ptrdiff_t nargs, if (INT_ADD_WRAPV (nargs, 1, &nargs1)) overflow_error (); SAFE_ALLOCA_LISP (newargs, nargs1); - newargs[0] = value_to_lisp (fun); + newargs[0] = value_to_lisp (func); for (ptrdiff_t i = 0; i < nargs; i++) newargs[1 + i] = value_to_lisp (args[i]); emacs_value result = lisp_to_value (env, Ffuncall (nargs1, newargs)); @@ -561,17 +606,17 @@ module_intern (emacs_env *env, const char *name) } static emacs_value -module_type_of (emacs_env *env, emacs_value value) +module_type_of (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - return lisp_to_value (env, Ftype_of (value_to_lisp (value))); + return lisp_to_value (env, Ftype_of (value_to_lisp (arg))); } static bool -module_is_not_nil (emacs_env *env, emacs_value value) +module_is_not_nil (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN_NO_CATCH (false); - return ! NILP (value_to_lisp (value)); + return ! NILP (value_to_lisp (arg)); } static bool @@ -582,14 +627,14 @@ module_eq (emacs_env *env, emacs_value a, emacs_value b) } static intmax_t -module_extract_integer (emacs_env *env, emacs_value n) +module_extract_integer (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object l = value_to_lisp (n); - CHECK_INTEGER (l); + Lisp_Object lisp = value_to_lisp (arg); + CHECK_INTEGER (lisp); intmax_t i; - if (! integer_to_intmax (l, &i)) - xsignal1 (Qoverflow_error, l); + if (! integer_to_intmax (lisp, &i)) + xsignal1 (Qoverflow_error, lisp); return i; } @@ -601,10 +646,10 @@ module_make_integer (emacs_env *env, intmax_t n) } static double -module_extract_float (emacs_env *env, emacs_value f) +module_extract_float (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object lisp = value_to_lisp (f); + Lisp_Object lisp = value_to_lisp (arg); CHECK_TYPE (FLOATP (lisp), Qfloatp, lisp); return XFLOAT_DATA (lisp); } @@ -617,8 +662,8 @@ module_make_float (emacs_env *env, double d) } static bool -module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, - ptrdiff_t *length) +module_copy_string_contents (emacs_env *env, emacs_value value, char *buf, + ptrdiff_t *len) { MODULE_FUNCTION_BEGIN (false); Lisp_Object lisp_str = value_to_lisp (value); @@ -642,77 +687,77 @@ module_copy_string_contents (emacs_env *env, emacs_value value, char *buffer, ptrdiff_t raw_size = SBYTES (lisp_str_utf8); ptrdiff_t required_buf_size = raw_size + 1; - if (buffer == NULL) + if (buf == NULL) { - *length = required_buf_size; + *len = required_buf_size; return true; } - if (*length < required_buf_size) + if (*len < required_buf_size) { - ptrdiff_t actual = *length; - *length = required_buf_size; + ptrdiff_t actual = *len; + *len = required_buf_size; args_out_of_range_3 (INT_TO_INTEGER (actual), INT_TO_INTEGER (required_buf_size), INT_TO_INTEGER (PTRDIFF_MAX)); } - *length = required_buf_size; - memcpy (buffer, SDATA (lisp_str_utf8), raw_size + 1); + *len = required_buf_size; + memcpy (buf, SDATA (lisp_str_utf8), raw_size + 1); return true; } static emacs_value -module_make_string (emacs_env *env, const char *str, ptrdiff_t length) +module_make_string (emacs_env *env, const char *str, ptrdiff_t len) { MODULE_FUNCTION_BEGIN (NULL); - if (! (0 <= length && length <= STRING_BYTES_BOUND)) + if (! (0 <= len && len <= STRING_BYTES_BOUND)) overflow_error (); - Lisp_Object lstr = make_string_from_utf8 (str, length); + Lisp_Object lstr = module_decode_utf_8 (str, len); return lisp_to_value (env, lstr); } static emacs_value -module_make_user_ptr (emacs_env *env, emacs_finalizer_function fin, void *ptr) +module_make_user_ptr (emacs_env *env, emacs_finalizer fin, void *ptr) { MODULE_FUNCTION_BEGIN (NULL); return lisp_to_value (env, make_user_ptr (fin, ptr)); } static void * -module_get_user_ptr (emacs_env *env, emacs_value uptr) +module_get_user_ptr (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); return XUSER_PTR (lisp)->p; } static void -module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr) +module_set_user_ptr (emacs_env *env, emacs_value arg, void *ptr) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); XUSER_PTR (lisp)->p = ptr; } -static emacs_finalizer_function -module_get_user_finalizer (emacs_env *env, emacs_value uptr) +static emacs_finalizer +module_get_user_finalizer (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); return XUSER_PTR (lisp)->finalizer; } static void -module_set_user_finalizer (emacs_env *env, emacs_value uptr, - emacs_finalizer_function fin) +module_set_user_finalizer (emacs_env *env, emacs_value arg, + emacs_finalizer fin) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lisp = value_to_lisp (uptr); + Lisp_Object lisp = value_to_lisp (arg); CHECK_USER_PTR (lisp); XUSER_PTR (lisp)->finalizer = fin; } @@ -727,30 +772,31 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i) } static void -module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) +module_vec_set (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) { MODULE_FUNCTION_BEGIN (); - Lisp_Object lvec = value_to_lisp (vec); - check_vec_index (lvec, i); - ASET (lvec, i, value_to_lisp (val)); + Lisp_Object lisp = value_to_lisp (vector); + check_vec_index (lisp, index); + ASET (lisp, index, value_to_lisp (value)); } static emacs_value -module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i) +module_vec_get (emacs_env *env, emacs_value vector, ptrdiff_t index) { MODULE_FUNCTION_BEGIN (NULL); - Lisp_Object lvec = value_to_lisp (vec); - check_vec_index (lvec, i); - return lisp_to_value (env, AREF (lvec, i)); + Lisp_Object lisp = value_to_lisp (vector); + check_vec_index (lisp, index); + return lisp_to_value (env, AREF (lisp, index)); } static ptrdiff_t -module_vec_size (emacs_env *env, emacs_value vec) +module_vec_size (emacs_env *env, emacs_value vector) { MODULE_FUNCTION_BEGIN (0); - Lisp_Object lvec = value_to_lisp (vec); - CHECK_VECTOR (lvec); - return ASIZE (lvec); + Lisp_Object lisp = value_to_lisp (vector); + CHECK_VECTOR (lisp); + return ASIZE (lisp); } /* This function should return true if and only if maybe_quit would @@ -771,10 +817,10 @@ module_process_input (emacs_env *env) } static struct timespec -module_extract_time (emacs_env *env, emacs_value value) +module_extract_time (emacs_env *env, emacs_value arg) { MODULE_FUNCTION_BEGIN ((struct timespec) {0}); - return lisp_time_argument (value_to_lisp (value)); + return lisp_time_argument (value_to_lisp (arg)); } static emacs_value @@ -1072,6 +1118,12 @@ module_function_address (const struct Lisp_Module_Function *function) return (module_funcptr) function->subr; } +void * +module_function_data (const struct Lisp_Module_Function *function) +{ + return function->data; +} + /* Helper functions. */ @@ -1088,14 +1140,14 @@ module_assert_thread (void) } static void -module_assert_runtime (struct emacs_runtime *ert) +module_assert_runtime (struct emacs_runtime *runtime) { if (! module_assertions) return; ptrdiff_t count = 0; for (Lisp_Object tail = Vmodule_runtimes; CONSP (tail); tail = XCDR (tail)) { - if (xmint_pointer (XCAR (tail)) == ert) + if (xmint_pointer (XCAR (tail)) == runtime) return; ++count; } @@ -1337,6 +1389,8 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) env->make_time = module_make_time; env->extract_big_integer = module_extract_big_integer; env->make_big_integer = module_make_big_integer; + env->get_function_finalizer = module_get_function_finalizer; + env->set_function_finalizer = module_set_function_finalizer; Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); return env; } diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 898021dc5e6..cd75c0907e4 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -42,6 +42,12 @@ information how to write modules and use this header file. # define EMACS_NOEXCEPT #endif +#if defined __cplusplus && __cplusplus >= 201703L +# define EMACS_NOEXCEPT_TYPEDEF noexcept +#else +# define EMACS_NOEXCEPT_TYPEDEF +#endif + #ifdef __has_attribute #if __has_attribute(__nonnull__) # define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__))) @@ -56,7 +62,7 @@ extern "C" { #endif /* Current environment. */ -typedef struct emacs_env_27 emacs_env; +typedef struct emacs_env_@emacs_major_version@ emacs_env; /* Opaque pointer representing an Emacs Lisp value. BEWARE: Do not assume NULL is a valid value! */ @@ -74,10 +80,25 @@ struct emacs_runtime struct emacs_runtime_private *private_members; /* Return an environment pointer. */ - emacs_env *(*get_environment) (struct emacs_runtime *ert) + emacs_env *(*get_environment) (struct emacs_runtime *runtime) EMACS_ATTRIBUTE_NONNULL(1); }; +/* Type aliases for function pointer types used in the module API. + Note that we don't use these aliases directly in the API to be able + to mark the function arguments as 'noexcept' before C++20. + However, users can use them if they want. */ + +/* Function prototype for the module Lisp functions. These must not + throw C++ exceptions. */ +typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, + void *data) + EMACS_NOEXCEPT_TYPEDEF EMACS_ATTRIBUTE_NONNULL (1); + +/* Function prototype for module user-pointer and function finalizers. + These must not throw C++ exceptions. */ +typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT_TYPEDEF; /* Possible Emacs function call outcomes. */ enum emacs_funcall_exit @@ -131,8 +152,19 @@ struct emacs_env_27 @module_env_snippet_27@ }; +struct emacs_env_28 +{ +@module_env_snippet_25@ + +@module_env_snippet_26@ + +@module_env_snippet_27@ + +@module_env_snippet_28@ +}; + /* Every module should define a function as follows. */ -extern int emacs_module_init (struct emacs_runtime *ert) +extern int emacs_module_init (struct emacs_runtime *runtime) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); diff --git a/src/emacs.c b/src/emacs.c index c5a760d29f6..c170333e603 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -930,7 +930,6 @@ main (int argc, char **argv) for pointers. */ void *stack_bottom_variable; - bool do_initial_setlocale; bool no_loadup = false; char *junk = 0; char *dname_arg = 0; @@ -1235,19 +1234,20 @@ main (int argc, char **argv) set_binary_mode (STDOUT_FILENO, O_BINARY); #endif /* MSDOS */ - /* Skip initial setlocale if LC_ALL is "C", as it's not needed in that case. - The build procedure uses this while dumping, to ensure that the - dumped Emacs does not have its system locale tables initialized, - as that might cause screwups when the dumped Emacs starts up. */ - { - char *lc_all = getenv ("LC_ALL"); - do_initial_setlocale = ! lc_all || strcmp (lc_all, "C"); - } - - /* Set locale now, so that initial error messages are localized properly. - fixup_locale must wait until later, since it builds strings. */ - if (do_initial_setlocale) - setlocale (LC_ALL, ""); + /* Set locale, so that initial error messages are localized properly. + However, skip this if LC_ALL is "C", as it's not needed in that case. + Skipping helps if dumping with unexec, to ensure that the dumped + Emacs does not have its system locale tables initialized, as that + might cause screwups when the dumped Emacs starts up. */ + char *lc_all = getenv ("LC_ALL"); + if (! (lc_all && strcmp (lc_all, "C") == 0)) + { + #ifdef HAVE_NS + ns_init_locale (); + #endif + setlocale (LC_ALL, ""); + fixup_locale (); + } text_quoting_flag = using_utf8 (); inhibit_window_system = 0; @@ -1576,14 +1576,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_alloc (); init_bignum (); init_threads (); - - if (do_initial_setlocale) - { - fixup_locale (); - Vsystem_messages_locale = Vprevious_system_messages_locale; - Vsystem_time_locale = Vprevious_system_time_locale; - } - init_eval (); init_atimer (); running_asynch_code = 0; @@ -1621,10 +1613,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem #ifdef HAVE_NS ns_pool = ns_alloc_autorelease_pool (); -#ifdef NS_IMPL_GNUSTEP - /* GNUstep stupidly resets our locale settings after we made them. */ - fixup_locale (); -#endif if (!noninteractive) { @@ -1735,11 +1723,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem globals_of_gfilenotify (); #endif -#ifdef HAVE_NS - /* Initialize the locale from user defaults. */ - ns_init_locale (); -#endif - /* Initialize and GC-protect Vinitial_environment and Vprocess_environment before set_initial_environment fills them in. */ @@ -2617,25 +2600,25 @@ synchronize_locale (int category, Lisp_Object *plocale, Lisp_Object desired_loca if (! EQ (*plocale, desired_locale)) { *plocale = desired_locale; -#ifdef WINDOWSNT + char const *locale_string + = STRINGP (desired_locale) ? SSDATA (desired_locale) : ""; +# ifdef WINDOWSNT /* Changing categories like LC_TIME usually requires specifying an encoding suitable for the new locale, but MS-Windows's 'setlocale' will only switch the encoding when LC_ALL is specified. So we ignore CATEGORY, use LC_ALL instead, and then restore LC_NUMERIC to "C", so reading and printing numbers is unaffected. */ - setlocale (LC_ALL, (STRINGP (desired_locale) - ? SSDATA (desired_locale) - : "")); + setlocale (LC_ALL, locale_string); fixup_locale (); -#else /* !WINDOWSNT */ - setlocale (category, (STRINGP (desired_locale) - ? SSDATA (desired_locale) - : "")); -#endif /* !WINDOWSNT */ +# else /* !WINDOWSNT */ + setlocale (category, locale_string); +# endif /* !WINDOWSNT */ } } +static Lisp_Object Vprevious_system_time_locale; + /* Set system time locale to match Vsystem_time_locale, if possible. */ void synchronize_system_time_locale (void) @@ -2644,15 +2627,19 @@ synchronize_system_time_locale (void) Vsystem_time_locale); } +# ifdef LC_MESSAGES +static Lisp_Object Vprevious_system_messages_locale; +# endif + /* Set system messages locale to match Vsystem_messages_locale, if possible. */ void synchronize_system_messages_locale (void) { -#ifdef LC_MESSAGES +# ifdef LC_MESSAGES synchronize_locale (LC_MESSAGES, &Vprevious_system_messages_locale, Vsystem_messages_locale); -#endif +# endif } #endif /* HAVE_SETLOCALE */ @@ -2974,19 +2961,16 @@ build directory. */); DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale, doc: /* System locale for messages. */); Vsystem_messages_locale = Qnil; - - DEFVAR_LISP ("previous-system-messages-locale", - Vprevious_system_messages_locale, - doc: /* Most recently used system locale for messages. */); +#ifdef LC_MESSAGES Vprevious_system_messages_locale = Qnil; + staticpro (&Vprevious_system_messages_locale); +#endif DEFVAR_LISP ("system-time-locale", Vsystem_time_locale, doc: /* System locale for time. */); Vsystem_time_locale = Qnil; - - DEFVAR_LISP ("previous-system-time-locale", Vprevious_system_time_locale, - doc: /* Most recently used system locale for time. */); Vprevious_system_time_locale = Qnil; + staticpro (&Vprevious_system_time_locale); DEFVAR_LISP ("before-init-time", Vbefore_init_time, doc: /* Value of `current-time' before Emacs begins initialization. */); diff --git a/src/fileio.c b/src/fileio.c index 482f88627a5..6b56c473abf 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1952,7 +1952,10 @@ barf_or_query_if_file_exists (Lisp_Object absname, bool known_to_exist, encoded_filename = ENCODE_FILE (absname); - if (! known_to_exist && lstat (SSDATA (encoded_filename), &statbuf) == 0) + if (! known_to_exist + && (emacs_fstatat (AT_FDCWD, SSDATA (encoded_filename), + &statbuf, AT_SYMLINK_NOFOLLOW) + == 0)) { if (S_ISDIR (statbuf.st_mode)) xsignal2 (Qfile_error, @@ -2555,7 +2558,9 @@ This is what happens in interactive use with M-x. */) bool dirp = !NILP (Fdirectory_name_p (file)); if (!dirp) { - if (lstat (SSDATA (encoded_file), &file_st) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (encoded_file), + &file_st, AT_SYMLINK_NOFOLLOW) + != 0) report_file_error ("Renaming", list2 (file, newname)); dirp = S_ISDIR (file_st.st_mode) != 0; } @@ -2928,7 +2933,8 @@ file_directory_p (Lisp_Object file) #else # ifdef O_PATH /* Use O_PATH if available, as it avoids races and EOVERFLOW issues. */ - int fd = openat (AT_FDCWD, SSDATA (file), O_PATH | O_CLOEXEC | O_DIRECTORY); + int fd = emacs_openat (AT_FDCWD, SSDATA (file), + O_PATH | O_CLOEXEC | O_DIRECTORY, 0); if (0 <= fd) { emacs_close (fd); @@ -2939,9 +2945,9 @@ file_directory_p (Lisp_Object file) /* O_PATH is defined but evidently this Linux kernel predates 2.6.39. Fall back on generic POSIX code. */ # endif - /* Use file_accessible_directory_p, as it avoids stat EOVERFLOW + /* Use file_accessible_directory_p, as it avoids fstatat EOVERFLOW problems and could be cheaper. However, if it fails because FILE - is inaccessible, fall back on stat; if the latter fails with + is inaccessible, fall back on fstatat; if the latter fails with EOVERFLOW then FILE must have been a directory unless a race condition occurred (a problem hard to work around portably). */ if (file_accessible_directory_p (file)) @@ -2949,7 +2955,7 @@ file_directory_p (Lisp_Object file) if (errno != EACCES) return false; struct stat st; - if (stat (SSDATA (file), &st) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (file), &st, 0) != 0) return errno == EOVERFLOW; if (S_ISDIR (st.st_mode)) return true; @@ -3080,7 +3086,7 @@ See `file-symlink-p' to distinguish symlinks. */) Vw32_get_true_file_attributes = Qt; #endif - int stat_result = stat (SSDATA (absname), &st); + int stat_result = emacs_fstatat (AT_FDCWD, SSDATA (absname), &st, 0); #ifdef WINDOWSNT Vw32_get_true_file_attributes = true_attributes; @@ -3340,7 +3346,7 @@ Return nil if FILENAME does not exist. */) if (!NILP (handler)) return call2 (handler, Qfile_modes, absname); - if (stat (SSDATA (ENCODE_FILE (absname)), &st) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname)), &st, 0) != 0) return file_attribute_errno (absname, errno); return make_fixnum (st.st_mode & 07777); } @@ -3486,7 +3492,7 @@ otherwise, if FILE2 does not exist, the answer is t. */) return call3 (handler, Qfile_newer_than_file_p, absname1, absname2); int err1; - if (stat (SSDATA (ENCODE_FILE (absname1)), &st1) == 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname1)), &st1, 0) == 0) err1 = 0; else { @@ -3494,7 +3500,7 @@ otherwise, if FILE2 does not exist, the answer is t. */) if (err1 != EOVERFLOW) return file_attribute_errno (absname1, err1); } - if (stat (SSDATA (ENCODE_FILE (absname2)), &st2) != 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (absname2)), &st2, 0) != 0) { file_attribute_errno (absname2, errno); return Qt; @@ -3880,7 +3886,7 @@ by calling `format-decode', which see. */) if (end_offset < 0) buffer_overflow (); - /* The file size returned from stat may be zero, but data + /* The file size returned from fstat may be zero, but data may be readable nonetheless, for example when this is a file in the /proc filesystem. */ if (end_offset == 0) @@ -5625,7 +5631,7 @@ See Info node `(elisp)Modification Time' for more details. */) filename = ENCODE_FILE (BVAR (b, filename)); - mtime = (stat (SSDATA (filename), &st) == 0 + mtime = (emacs_fstatat (AT_FDCWD, SSDATA (filename), &st, 0) == 0 ? get_stat_mtime (&st) : time_error_value (errno)); if (timespec_cmp (mtime, b->modtime) == 0 @@ -5689,7 +5695,8 @@ in `current-time' or an integer flag as returned by `visited-file-modtime'. */) /* The handler can find the file name the same way we did. */ return call2 (handler, Qset_visited_file_modtime, Qnil); - if (stat (SSDATA (ENCODE_FILE (filename)), &st) == 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (ENCODE_FILE (filename)), &st, 0) + == 0) { current_buffer->modtime = get_stat_mtime (&st); current_buffer->modtime_size = st.st_size; @@ -5728,12 +5735,14 @@ auto_save_1 (void) /* Get visited file's mode to become the auto save file's mode. */ if (! NILP (BVAR (current_buffer, filename))) { - if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) + if (emacs_fstatat (AT_FDCWD, SSDATA (BVAR (current_buffer, filename)), + &st, 0) + == 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = (st.st_mode | 0600) & 0777; else if (modes = Ffile_modes (BVAR (current_buffer, filename)), FIXNUMP (modes)) - /* Remote files don't cooperate with stat. */ + /* Remote files don't cooperate with fstatat. */ auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777; } diff --git a/src/filelock.c b/src/filelock.c index b28f16e9b5a..73202f0b2c4 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -347,7 +347,8 @@ rename_lock_file (char const *old, char const *new, bool force) potential race condition since some other process may create NEW immediately after the existence check, but it's the best we can portably do here. */ - if (lstat (new, &st) == 0 || errno == EOVERFLOW) + if (emacs_fstatat (AT_FDCWD, new, &st, AT_SYMLINK_NOFOLLOW) == 0 + || errno == EOVERFLOW) { errno = EEXIST; return -1; diff --git a/src/fns.c b/src/fns.c index 3b5feace521..80012fa9d28 100644 --- a/src/fns.c +++ b/src/fns.c @@ -47,6 +47,7 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); +static EMACS_UINT sxhash_obj (Lisp_Object, int); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the ARGUMENT unchanged. */ @@ -2433,6 +2434,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, same size. */ if (ASIZE (o2) != size) return false; + + /* Compare bignums, overlays, markers, and boolvectors + specially, by comparing their values. */ if (BIGNUMP (o1)) return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0; if (OVERLAYP (o1)) @@ -2453,21 +2457,12 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, && (XMARKER (o1)->buffer == 0 || XMARKER (o1)->bytepos == XMARKER (o2)->bytepos)); } - /* Boolvectors are compared much like strings. */ if (BOOL_VECTOR_P (o1)) { EMACS_INT size = bool_vector_size (o1); - if (size != bool_vector_size (o2)) - return false; - if (memcmp (bool_vector_data (o1), bool_vector_data (o2), - bool_vector_bytes (size))) - return false; - return true; - } - if (WINDOW_CONFIGURATIONP (o1)) - { - eassert (equal_kind != EQUAL_NO_QUIT); - return compare_window_configurations (o1, o2, false); + return (size == bool_vector_size (o2) + && !memcmp (bool_vector_data (o1), bool_vector_data (o2), + bool_vector_bytes (size))); } /* Aside from them, only true vectors, char-tables, compiled @@ -2493,16 +2488,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind, break; case Lisp_String: - if (SCHARS (o1) != SCHARS (o2)) - return false; - if (SBYTES (o1) != SBYTES (o2)) - return false; - if (memcmp (SDATA (o1), SDATA (o2), SBYTES (o1))) - return false; - if (equal_kind == EQUAL_INCLUDING_PROPERTIES - && !compare_string_intervals (o1, o2)) - return false; - return true; + return (SCHARS (o1) == SCHARS (o2) + && SBYTES (o1) == SBYTES (o2) + && !memcmp (SDATA (o1), SDATA (o2), SBYTES (o1)) + && (equal_kind != EQUAL_INCLUDING_PROPERTIES + || compare_string_intervals (o1, o2))); default: break; @@ -2853,7 +2843,7 @@ advisable. */) while (loads-- > 0) { Lisp_Object load = (NILP (use_floats) - ? make_fixnum (100.0 * load_ave[loads]) + ? double_to_integer (100.0 * load_ave[loads]) : make_float (load_ave[loads])); ret = Fcons (load, ret); } @@ -4022,7 +4012,7 @@ hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) Lisp_Object hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { - return make_ufixnum (sxhash (key, 0)); + return make_ufixnum (sxhash (key)); } /* Ignore HT and return a hash code for KEY which uses 'eql' to compare keys. @@ -4042,7 +4032,7 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { Lisp_Object args[] = { h->test.user_hash_function, key }; Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h); - return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash, 0)); + return FIXNUMP (hash) ? hash : make_ufixnum (sxhash (hash)); } struct hash_table_test const @@ -4606,13 +4596,13 @@ sxhash_list (Lisp_Object list, int depth) CONSP (list) && i < SXHASH_MAX_LEN; list = XCDR (list), ++i) { - EMACS_UINT hash2 = sxhash (XCAR (list), depth + 1); + EMACS_UINT hash2 = sxhash_obj (XCAR (list), depth + 1); hash = sxhash_combine (hash, hash2); } if (!NILP (list)) { - EMACS_UINT hash2 = sxhash (list, depth + 1); + EMACS_UINT hash2 = sxhash_obj (list, depth + 1); hash = sxhash_combine (hash, hash2); } @@ -4632,7 +4622,7 @@ sxhash_vector (Lisp_Object vec, int depth) n = min (SXHASH_MAX_LEN, hash & PSEUDOVECTOR_FLAG ? PVSIZE (vec) : hash); for (i = 0; i < n; ++i) { - EMACS_UINT hash2 = sxhash (AREF (vec, i), depth + 1); + EMACS_UINT hash2 = sxhash_obj (AREF (vec, i), depth + 1); hash = sxhash_combine (hash, hash2); } @@ -4675,58 +4665,78 @@ sxhash_bignum (Lisp_Object bignum) structure. Value is an unsigned integer clipped to INTMASK. */ EMACS_UINT -sxhash (Lisp_Object obj, int depth) +sxhash (Lisp_Object obj) { - EMACS_UINT hash; + return sxhash_obj (obj, 0); +} +static EMACS_UINT +sxhash_obj (Lisp_Object obj, int depth) +{ if (depth > SXHASH_MAX_DEPTH) return 0; switch (XTYPE (obj)) { case_Lisp_Int: - hash = XUFIXNUM (obj); - break; + return XUFIXNUM (obj); case Lisp_Symbol: - hash = XHASH (obj); - break; + return XHASH (obj); case Lisp_String: - hash = sxhash_string (SSDATA (obj), SBYTES (obj)); - break; + return sxhash_string (SSDATA (obj), SBYTES (obj)); - /* This can be everything from a vector to an overlay. */ case Lisp_Vectorlike: - if (BIGNUMP (obj)) - hash = sxhash_bignum (obj); - else if (VECTORP (obj) || RECORDP (obj)) - /* According to the CL HyperSpec, two arrays are equal only if - they are `eq', except for strings and bit-vectors. In - Emacs, this works differently. We have to compare element - by element. Same for records. */ - hash = sxhash_vector (obj, depth); - else if (BOOL_VECTOR_P (obj)) - hash = sxhash_bool_vector (obj); - else - /* Others are `equal' if they are `eq', so let's take their - address as hash. */ - hash = XHASH (obj); - break; + { + enum pvec_type pvec_type = PSEUDOVECTOR_TYPE (XVECTOR (obj)); + if (! (PVEC_NORMAL_VECTOR < pvec_type && pvec_type < PVEC_COMPILED)) + { + /* According to the CL HyperSpec, two arrays are equal only if + they are 'eq', except for strings and bit-vectors. In + Emacs, this works differently. We have to compare element + by element. Same for pseudovectors that internal_equal + examines the Lisp contents of. */ + return (SUB_CHAR_TABLE_P (obj) + /* 'sxhash_vector' can't be applies to a sub-char-table and + it's probably not worth looking into them anyway! */ + ? 42 + : sxhash_vector (obj, depth)); + } + else if (pvec_type == PVEC_BIGNUM) + return sxhash_bignum (obj); + else if (pvec_type == PVEC_MARKER) + { + ptrdiff_t bytepos + = XMARKER (obj)->buffer ? XMARKER (obj)->bytepos : 0; + EMACS_UINT hash + = sxhash_combine ((intptr_t) XMARKER (obj)->buffer, bytepos); + return SXHASH_REDUCE (hash); + } + else if (pvec_type == PVEC_BOOL_VECTOR) + return sxhash_bool_vector (obj); + else if (pvec_type == PVEC_OVERLAY) + { + EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth); + hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth)); + hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist, depth)); + return SXHASH_REDUCE (hash); + } + else + /* Others are 'equal' if they are 'eq', so take their + address as hash. */ + return XHASH (obj); + } case Lisp_Cons: - hash = sxhash_list (obj, depth); - break; + return sxhash_list (obj, depth); case Lisp_Float: - hash = sxhash_float (XFLOAT_DATA (obj)); - break; + return sxhash_float (XFLOAT_DATA (obj)); default: emacs_abort (); } - - return hash; } diff --git a/src/font.c b/src/font.c index 2b90903c909..bb39aef92d5 100644 --- a/src/font.c +++ b/src/font.c @@ -5545,7 +5545,6 @@ cause Xft crashes. Only has an effect in Xft builds. */); #ifdef USE_CAIRO syms_of_ftcrfont (); #else - syms_of_ftxfont (); #ifdef HAVE_XFT syms_of_xftfont (); #endif /* HAVE_XFT */ diff --git a/src/font.h b/src/font.h index 633d92709c5..0561e3c83f5 100644 --- a/src/font.h +++ b/src/font.h @@ -69,8 +69,8 @@ INLINE_HEADER_BEGIN enum font_property_index { - /* FONT-TYPE is a symbol indicating a font backend; currently `x', - `xft', and `ftx' are available on X, `uniscribe' and `gdi' on + /* FONT-TYPE is a symbol indicating a font backend; currently `x' + and `xft' are available on X, `uniscribe' and `gdi' on Windows, and `ns' under Cocoa / GNUstep. */ FONT_TYPE_INDEX, @@ -938,7 +938,6 @@ extern void syms_of_ftfont (void); extern struct font_driver const xfont_driver; extern Lisp_Object xfont_get_cache (struct frame *); extern void syms_of_xfont (void); -extern void syms_of_ftxfont (void); #ifdef HAVE_XFT extern struct font_driver const xftfont_driver; #ifdef HAVE_HARFBUZZ @@ -946,7 +945,6 @@ extern struct font_driver xfthbfont_driver; #endif /* HAVE_HARFBUZZ */ #endif #if defined HAVE_FREETYPE || defined HAVE_XFT -extern struct font_driver const ftxfont_driver; extern void syms_of_xftfont (void); #endif #ifdef HAVE_BDFFONT diff --git a/src/frame.c b/src/frame.c index 88d6f22fc0a..51fc78ab703 100644 --- a/src/frame.c +++ b/src/frame.c @@ -904,7 +904,7 @@ make_frame (bool mini_p) f->last_tool_bar_item = -1; #endif #ifdef NS_IMPL_COCOA - f->ns_appearance = ns_appearance_aqua; + f->ns_appearance = ns_appearance_system_default; f->ns_transparent_titlebar = false; #endif #endif diff --git a/src/frame.h b/src/frame.h index a54b8623e50..641bb430d0e 100644 --- a/src/frame.h +++ b/src/frame.h @@ -69,8 +69,9 @@ enum internal_border_part #ifdef NS_IMPL_COCOA enum ns_appearance_type { - ns_appearance_aqua, - ns_appearance_vibrant_dark + ns_appearance_system_default, + ns_appearance_aqua, + ns_appearance_vibrant_dark }; #endif #endif /* HAVE_WINDOW_SYSTEM */ diff --git a/src/ftxfont.c b/src/ftxfont.c deleted file mode 100644 index 9bbb2c064c2..00000000000 --- a/src/ftxfont.c +++ /dev/null @@ -1,371 +0,0 @@ -/* ftxfont.c -- FreeType font driver on X (without using XFT). - Copyright (C) 2006-2020 Free Software Foundation, Inc. - Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 - National Institute of Advanced Industrial Science and Technology (AIST) - Registration Number H13PRO009 - -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 <https://www.gnu.org/licenses/>. */ - -#include <config.h> -#include <X11/Xlib.h> - -#include "lisp.h" -#include "xterm.h" -#include "frame.h" -#include "blockinput.h" -#include "font.h" -#include "pdumper.h" - -/* FTX font driver. */ - -struct ftxfont_frame_data -{ - /* Background and foreground colors. */ - XColor colors[2]; - /* GCs interpolating the above colors. gcs[0] is for a color - closest to BACKGROUND, and gcs[5] is for a color closest to - FOREGROUND. */ - GC gcs[6]; - struct ftxfont_frame_data *next; -}; - - -/* Return an array of 6 GCs for antialiasing. */ - -static GC * -ftxfont_get_gcs (struct frame *f, unsigned long foreground, unsigned long background) -{ - XColor color; - XGCValues xgcv; - int i; - struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx); - struct ftxfont_frame_data *prev = NULL, *this = NULL, *new; - - if (data) - { - for (this = data; this; prev = this, this = this->next) - { - if (this->colors[0].pixel < background) - continue; - if (this->colors[0].pixel > background) - break; - if (this->colors[1].pixel < foreground) - continue; - if (this->colors[1].pixel > foreground) - break; - return this->gcs; - } - } - - new = xmalloc (sizeof *new); - new->next = this; - if (prev) - prev->next = new; - font_put_frame_data (f, Qftx, new); - - new->colors[0].pixel = background; - new->colors[1].pixel = foreground; - - block_input (); - XQueryColors (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), new->colors, 2); - for (i = 1; i < 7; i++) - { - /* Interpolate colors linearly. Any better algorithm? */ - color.red - = (new->colors[1].red * i + new->colors[0].red * (8 - i)) / 8; - color.green - = (new->colors[1].green * i + new->colors[0].green * (8 - i)) / 8; - color.blue - = (new->colors[1].blue * i + new->colors[0].blue * (8 - i)) / 8; - if (! x_alloc_nearest_color (f, FRAME_X_COLORMAP (f), &color)) - break; - xgcv.foreground = color.pixel; - new->gcs[i - 1] = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - GCForeground, &xgcv); - } - unblock_input (); - - if (i < 7) - { - block_input (); - for (i--; i >= 0; i--) - XFreeGC (FRAME_X_DISPLAY (f), new->gcs[i]); - unblock_input (); - if (prev) - prev->next = new->next; - else if (data) - font_put_frame_data (f, Qftx, new->next); - xfree (new); - return NULL; - } - return new->gcs; -} - -static int -ftxfont_draw_bitmap (struct frame *f, GC gc_fore, GC *gcs, struct font *font, - unsigned int code, int x, int y, XPoint *p, int size, - int *n, bool flush) -{ - struct font_bitmap bitmap; - unsigned char *b; - int i, j; - - if (ftfont_get_bitmap (font, code, &bitmap, size > 0x100 ? 1 : 8) < 0) - return 0; - if (size > 0x100) - { - for (i = 0, b = bitmap.buffer; i < bitmap.rows; - i++, b += bitmap.pitch) - { - for (j = 0; j < bitmap.width; j++) - if (b[j / 8] & (1 << (7 - (j % 8)))) - { - p[n[0]].x = x + bitmap.left + j; - p[n[0]].y = y - bitmap.top + i; - if (++n[0] == size) - { - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p, size, CoordModeOrigin); - n[0] = 0; - } - } - } - if (flush && n[0] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p, n[0], CoordModeOrigin); - } - else - { - for (i = 0, b = bitmap.buffer; i < bitmap.rows; - i++, b += bitmap.pitch) - { - for (j = 0; j < bitmap.width; j++) - { - int idx = (bitmap.bits_per_pixel == 1 - ? ((b[j / 8] & (1 << (7 - (j % 8)))) ? 6 : -1) - : (b[j] >> 5) - 1); - - if (idx >= 0) - { - XPoint *pp = p + size * idx; - - pp[n[idx]].x = x + bitmap.left + j; - pp[n[idx]].y = y - bitmap.top + i; - if (++(n[idx]) == size) - { - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - idx == 6 ? gc_fore : gcs[idx], pp, size, - CoordModeOrigin); - n[idx] = 0; - } - } - } - } - if (flush) - { - for (i = 0; i < 6; i++) - if (n[i] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gcs[i], p + 0x100 * i, n[i], CoordModeOrigin); - if (n[6] > 0) - XDrawPoints (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), - gc_fore, p + 0x600, n[6], CoordModeOrigin); - } - } - - /* There is no ftfont_free_bitmap, so do not try to free BITMAP. */ - - return bitmap.advance; -} - -static void -ftxfont_draw_background (struct frame *f, struct font *font, GC gc, int x, int y, - int width) -{ - XGCValues xgcv; - - XGetGCValues (FRAME_X_DISPLAY (f), gc, - GCForeground | GCBackground, &xgcv); - XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.background); - XFillRectangle (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), gc, - x, y - FONT_BASE (font), width, FONT_HEIGHT (font)); - XSetForeground (FRAME_X_DISPLAY (f), gc, xgcv.foreground); -} - -static Lisp_Object -ftxfont_list (struct frame *f, Lisp_Object spec) -{ - return ftfont_list2 (f, spec, Qftx); -} - -static Lisp_Object -ftxfont_match (struct frame *f, Lisp_Object spec) -{ - return ftfont_match2 (f, spec, Qftx); -} - -static Lisp_Object -ftxfont_open (struct frame *f, Lisp_Object entity, int pixel_size) -{ - Lisp_Object font_object = ftfont_open (f, entity, pixel_size); - if (NILP (font_object)) - return Qnil; - struct font *font = XFONT_OBJECT (font_object); - font->driver = &ftxfont_driver; - return font_object; -} - -static void -ftxfont_close (struct font *font) -{ - ftfont_close (font); -} - -static int -ftxfont_draw (struct glyph_string *s, int from, int to, int x, int y, - bool with_background) -{ - struct frame *f = s->f; - struct face *face = s->face; - struct font *font = s->font; - XPoint p[0x700]; - int n[7]; - unsigned *code = s->char2b + from; - int len = to - from; - int i; - GC *gcs; - int xadvance; - - n[0] = n[1] = n[2] = n[3] = n[4] = n[5] = n[6] = 0; - - block_input (); - if (with_background) - ftxfont_draw_background (f, font, s->gc, x, y, s->width); - - if (face->gc == s->gc) - { - gcs = ftxfont_get_gcs (f, face->foreground, face->background); - } - else - { - XGCValues xgcv; - unsigned long mask = GCForeground | GCBackground; - - XGetGCValues (FRAME_X_DISPLAY (f), s->gc, mask, &xgcv); - gcs = ftxfont_get_gcs (f, xgcv.foreground, xgcv.background); - } - - if (gcs) - { - if (s->num_clips) - for (i = 0; i < 6; i++) - XSetClipRectangles (FRAME_X_DISPLAY (f), gcs[i], 0, 0, - s->clip, s->num_clips, Unsorted); - - for (i = 0; i < len; i++) - { - xadvance = ftxfont_draw_bitmap (f, s->gc, gcs, font, code[i], x, y, - p, 0x100, n, i + 1 == len); - x += (s->padding_p ? 1 : xadvance); - } - if (s->num_clips) - for (i = 0; i < 6; i++) - XSetClipMask (FRAME_X_DISPLAY (f), gcs[i], None); - } - else - { - /* We can't draw with antialiasing. - s->gc should already have a proper clipping setting. */ - for (i = 0; i < len; i++) - { - xadvance = ftxfont_draw_bitmap (f, s->gc, NULL, font, code[i], x, y, - p, 0x700, n, i + 1 == len); - x += (s->padding_p ? 1 : xadvance); - } - } - - unblock_input (); - - return len; -} - -static int -ftxfont_end_for_frame (struct frame *f) -{ - struct ftxfont_frame_data *data = font_get_frame_data (f, Qftx); - - block_input (); - while (data) - { - struct ftxfont_frame_data *next = data->next; - int i; - - for (i = 0; i < 6; i++) - XFreeGC (FRAME_X_DISPLAY (f), data->gcs[i]); - xfree (data); - data = next; - } - unblock_input (); - font_put_frame_data (f, Qftx, NULL); - return 0; -} - - - -static void syms_of_ftxfont_for_pdumper (void); - -struct font_driver const ftxfont_driver = - { - /* We can't draw a text without device dependent functions. */ - .type = LISPSYM_INITIALLY (Qftx), - .get_cache = ftfont_get_cache, - .list = ftxfont_list, - .match = ftxfont_match, - .list_family = ftfont_list_family, - .open_font = ftxfont_open, - .close_font = ftxfont_close, - .has_char = ftfont_has_char, - .encode_char = ftfont_encode_char, - .text_extents = ftfont_text_extents, - .draw = ftxfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, -#ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, -#endif - .end_for_frame = ftxfont_end_for_frame, -#if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = ftfont_shape, -#endif -#if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX - .get_variation_glyphs = ftfont_variation_glyphs, -#endif - .filter_properties = ftfont_filter_properties, - .combining_capability = ftfont_combining_capability, - }; - -void -syms_of_ftxfont (void) -{ - DEFSYM (Qftx, "ftx"); - pdumper_do_now_and_after_load (syms_of_ftxfont_for_pdumper); -} - -static void -syms_of_ftxfont_for_pdumper (void) -{ - register_font_driver (&ftxfont_driver, NULL); -} diff --git a/src/gtkutil.c b/src/gtkutil.c index 6308c38f164..5e7cf3d2114 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -22,6 +22,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef USE_GTK #include <float.h> #include <stdio.h> +#include <stdlib.h> #include <c-ctype.h> diff --git a/src/image.c b/src/image.c index 56878bcb8cb..65d59254f02 100644 --- a/src/image.c +++ b/src/image.c @@ -1620,7 +1620,7 @@ search_image_cache (struct frame *f, Lisp_Object spec, EMACS_UINT hash) static void uncache_image (struct frame *f, Lisp_Object spec) { - struct image *img = search_image_cache (f, spec, sxhash (spec, 0)); + struct image *img = search_image_cache (f, spec, sxhash (spec)); if (img) { free_image (f, img); @@ -2285,7 +2285,7 @@ lookup_image (struct frame *f, Lisp_Object spec) eassert (valid_image_p (spec)); /* Look up SPEC in the hash table of the image cache. */ - hash = sxhash (spec, 0); + hash = sxhash (spec); img = search_image_cache (f, spec, hash); if (img && img->load_failed_p) { diff --git a/src/json.c b/src/json.c index 2e50ce514fd..30027675580 100644 --- a/src/json.c +++ b/src/json.c @@ -1121,7 +1121,6 @@ syms_of_json (void) DEFSYM (Qstring_without_embedded_nulls_p, "string-without-embedded-nulls-p"); DEFSYM (Qjson_value_p, "json-value-p"); - DEFSYM (Qutf_8_string_p, "utf-8-string-p"); DEFSYM (Qjson_error, "json-error"); DEFSYM (Qjson_out_of_memory, "json-out-of-memory"); diff --git a/src/keyboard.c b/src/keyboard.c index bf1f5da22d3..9dd7e00709e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2901,6 +2901,12 @@ read_char (int commandflag, Lisp_Object map, example banishing the mouse under mouse-avoidance-mode. */ timer_resume_idle (); +#ifdef HAVE_NS + if (CONSP (c) + && (EQ (XCAR (c), intern ("ns-unput-working-text")))) + input_was_pending = input_pending; +#endif + if (current_buffer != prev_buffer) { /* The command may have changed the keymaps. Pretend there diff --git a/src/lcms.c b/src/lcms.c index a74c5539860..c19397f4baa 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -317,7 +317,7 @@ jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2) } DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0, - doc: /* Convert CIE CAM02 JCh to CIE XYZ. + doc: /* Convert CIE XYZ to CIE CAM02 JCh. COLOR is a list (X Y Z), with Y scaled about unity. Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', which see. */) @@ -353,7 +353,7 @@ which see. */) } DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0, - doc: /* Convert CIE XYZ to CIE CAM02 JCh. + doc: /* Convert CIE CAM02 JCh to CIE XYZ. COLOR is a list (J C h), where lightness of white is equal to 100, and hue is given in degrees. Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', diff --git a/src/lisp.h b/src/lisp.h index 8674fe11a64..0bd375658e2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1069,7 +1069,7 @@ DEFINE_GDB_SYMBOL_END (PSEUDOVECTOR_FLAG) with PVEC_TYPE_MASK to indicate the actual type. */ enum pvec_type { - PVEC_NORMAL_VECTOR, + PVEC_NORMAL_VECTOR, /* Should be first, for sxhash_obj. */ PVEC_FREE, PVEC_BIGNUM, PVEC_MARKER, @@ -1094,7 +1094,7 @@ enum pvec_type PVEC_CONDVAR, PVEC_MODULE_FUNCTION, - /* These should be last, check internal_equal to see why. */ + /* These should be last, for internal_equal and sxhash_obj. */ PVEC_COMPILED, PVEC_CHAR_TABLE, PVEC_SUB_CHAR_TABLE, @@ -3652,7 +3652,7 @@ extern bool sweep_weak_table (struct Lisp_Hash_Table *, bool); extern void hexbuf_digest (char *, void const *, int); extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); -EMACS_UINT sxhash (Lisp_Object, int); +EMACS_UINT sxhash (Lisp_Object); Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); @@ -3812,7 +3812,7 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern void *my_heap_start (void); extern void check_pure_size (void); -extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); +unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); extern AVOID buffer_memory_full (ptrdiff_t); @@ -3942,6 +3942,7 @@ extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern void make_byte_code (struct Lisp_Vector *); extern struct Lisp_Vector *allocate_vector (ptrdiff_t); +extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); /* Make an uninitialized vector for SIZE objects. NOTE: you must be sure that GC cannot happen until the vector is completely @@ -3977,9 +3978,7 @@ make_uninit_sub_char_table (int depth, int min_char) INLINE Lisp_Object make_nil_vector (ptrdiff_t size) { - Lisp_Object vec = make_uninit_vector (size); - memclear (XVECTOR (vec)->contents, size * word_size); - return vec; + return make_lisp_ptr (allocate_nil_vector (size), Lisp_Vectorlike); } extern struct Lisp_Vector *allocate_pseudovector (int, int, int, @@ -4245,6 +4244,8 @@ extern Lisp_Object module_function_documentation (struct Lisp_Module_Function const *); extern module_funcptr module_function_address (struct Lisp_Module_Function const *); +extern void *module_function_data (const struct Lisp_Module_Function *); +extern void module_finalize_function (const struct Lisp_Module_Function *); extern void mark_modules (void); extern void init_module_assertions (bool); extern void syms_of_module (void); @@ -4604,6 +4605,8 @@ extern void seed_random (void *, ptrdiff_t); extern void init_random (void); extern void emacs_backtrace (int); extern AVOID emacs_abort (void) NO_INLINE; +extern int emacs_fstatat (int, char const *, void *, int); +extern int emacs_openat (int, char const *, int, int); extern int emacs_open (const char *, int, int); extern int emacs_pipe (int[2]); extern int emacs_close (int); diff --git a/src/lread.c b/src/lread.c index af7480a9769..70984d37e18 100644 --- a/src/lread.c +++ b/src/lread.c @@ -152,12 +152,6 @@ static ptrdiff_t prev_saved_doc_string_length; /* This is the file position that string came from. */ static file_offset prev_saved_doc_string_position; -/* True means inside a new-style backquote with no surrounding - parentheses. Fread initializes this to the value of - `force_new_style_backquotes', so we need not specbind it or worry - about what happens to it when there is an error. */ -static bool new_backquote_flag; - /* A list of file names for files being loaded in Fload. Used to check for recursive loads. */ @@ -1035,18 +1029,6 @@ load_error_handler (Lisp_Object data) return Qnil; } -static AVOID -load_error_old_style_backquotes (void) -{ - if (NILP (Vload_file_name)) - xsignal1 (Qerror, build_string ("Old-style backquotes detected!")); - else - { - AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); - xsignal1 (Qerror, CALLN (Fformat_message, format, Vload_file_name)); - } -} - static void load_warn_unescaped_character_literals (Lisp_Object file) { @@ -1199,6 +1181,9 @@ Return t if the file exists and loads successfully. */) || suffix_p (file, ".elc") #ifdef HAVE_MODULES || suffix_p (file, MODULES_SUFFIX) +#ifdef MODULES_SECONDARY_SUFFIX + || suffix_p (file, MODULES_SECONDARY_SUFFIX) +#endif #endif ) must_suffix = Qnil; @@ -1268,7 +1253,12 @@ Return t if the file exists and loads successfully. */) } #ifdef HAVE_MODULES - bool is_module = suffix_p (found, MODULES_SUFFIX); + bool is_module = + suffix_p (found, MODULES_SUFFIX) +#ifdef MODULES_SECONDARY_SUFFIX + || suffix_p (found, MODULES_SECONDARY_SUFFIX) +#endif + ; #else bool is_module = false; #endif @@ -1345,11 +1335,11 @@ Return t if the file exists and loads successfully. */) ignores suffix order due to load_prefer_newer. */ if (!load_prefer_newer && is_elc) { - result = stat (SSDATA (efound), &s1); + result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s1, 0); if (result == 0) { SSET (efound, SBYTES (efound) - 1, 0); - result = stat (SSDATA (efound), &s2); + result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s2, 0); SSET (efound, SBYTES (efound) - 1, 'c'); } @@ -2275,7 +2265,6 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) Lisp_Object retval; readchar_count = 0; - new_backquote_flag = force_new_style_backquotes; /* We can get called from readevalloop which may have set these already. */ if (! HASH_TABLE_P (read_objects_map) @@ -2985,6 +2974,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) vec = XVECTOR (tmp); if (vec->header.size == 0) invalid_syntax ("Empty byte-code object"); + + if (COMPILED_DOC_STRING < vec->header.size + && EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0))) + { + /* read_list found a docstring like '(#$ . 5521)' and treated it + as 0. This placeholder 0 would lead to accidental sharing in + purecopy's hash-consing, so replace it with a (hopefully) + unique integer placeholder, which is negative so that it is + not confused with a DOC file offset (the USE_LSB_TAG shift + relies on the fact that VALMASK is one bit narrower than + INTMASK). Eventually Snarf-documentation should replace the + placeholder with the actual docstring. */ + verify (INTMASK & ~VALMASK); + EMACS_UINT hash = ((XHASH (tmp) >> USE_LSB_TAG) + | (INTMASK - INTMASK / 2)); + ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash)); + } + make_byte_code (vec); return tmp; } @@ -3263,70 +3270,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) return list2 (Qquote, read0 (readcharfun)); case '`': - { - int next_char = READCHAR; - UNREAD (next_char); - /* Transition from old-style to new-style: - If we see "(`" it used to mean old-style, which usually works - fine because ` should almost never appear in such a position - for new-style. But occasionally we need "(`" to mean new - style, so we try to distinguish the two by the fact that we - can either write "( `foo" or "(` foo", where the first - intends to use new-style whereas the second intends to use - old-style. For Emacs-25, we should completely remove this - first_in_list exception (old-style can still be obtained via - "(\`" anyway). */ - if (!new_backquote_flag && first_in_list && next_char == ' ') - load_error_old_style_backquotes (); - else - { - Lisp_Object value; - bool saved_new_backquote_flag = new_backquote_flag; - - new_backquote_flag = 1; - value = read0 (readcharfun); - new_backquote_flag = saved_new_backquote_flag; + return list2 (Qbackquote, read0 (readcharfun)); - return list2 (Qbackquote, value); - } - } case ',': { - int next_char = READCHAR; - UNREAD (next_char); - /* Transition from old-style to new-style: - It used to be impossible to have a new-style , other than within - a new-style `. This is sufficient when ` and , are used in the - normal way, but ` and , can also appear in args to macros that - will not interpret them in the usual way, in which case , may be - used without any ` anywhere near. - So we now use the same heuristic as for backquote: old-style - unquotes are only recognized when first on a list, and when - followed by a space. - Because it's more difficult to peek 2 chars ahead, a new-style - ,@ can still not be used outside of a `, unless it's in the middle - of a list. */ - if (new_backquote_flag - || !first_in_list - || (next_char != ' ' && next_char != '@')) - { - Lisp_Object comma_type = Qnil; - Lisp_Object value; - int ch = READCHAR; + Lisp_Object comma_type = Qnil; + Lisp_Object value; + int ch = READCHAR; - if (ch == '@') - comma_type = Qcomma_at; - else - { - if (ch >= 0) UNREAD (ch); - comma_type = Qcomma; - } - - value = read0 (readcharfun); - return list2 (comma_type, value); - } + if (ch == '@') + comma_type = Qcomma_at; else - load_error_old_style_backquotes (); + { + if (ch >= 0) UNREAD (ch); + comma_type = Qcomma; + } + + value = read0 (readcharfun); + return list2 (comma_type, value); } case '?': { @@ -4856,9 +4817,16 @@ This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); #ifdef HAVE_MODULES +#ifdef MODULES_SECONDARY_SUFFIX + Vload_suffixes = list4 (build_pure_c_string (".elc"), + build_pure_c_string (".el"), + build_pure_c_string (MODULES_SUFFIX), + build_pure_c_string (MODULES_SECONDARY_SUFFIX)); +#else Vload_suffixes = list3 (build_pure_c_string (".elc"), build_pure_c_string (".el"), build_pure_c_string (MODULES_SUFFIX)); +#endif #else Vload_suffixes = list2 (build_pure_c_string (".elc"), build_pure_c_string (".el")); @@ -5050,17 +5018,6 @@ Note that if you customize this, obviously it will not affect files that are loaded before your customizations are read! */); load_prefer_newer = 0; - DEFVAR_BOOL ("force-new-style-backquotes", force_new_style_backquotes, - doc: /* Non-nil means to always use the current syntax for backquotes. -If nil, `load' and `read' raise errors when encountering some -old-style variants of backquote and comma. If non-nil, these -constructs are always interpreted as described in the Info node -`(elisp)Backquote', even if that interpretation is incompatible with -previous versions of Emacs. Setting this variable to non-nil makes -Emacs compatible with the behavior planned for Emacs 28. In Emacs 28, -this variable will become obsolete. */); - force_new_style_backquotes = false; - /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); diff --git a/src/macfont.m b/src/macfont.m index c1bc30ff3ec..442a2566037 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -1126,7 +1126,8 @@ struct macfont_metrics }; #define METRICS_VALUE(metrics, member) \ - (((metrics)->member##_high << 8) | (metrics)->member##_low) + ((int) (((unsigned int) (metrics)->member##_high << 8) \ + | (metrics)->member##_low)) #define METRICS_SET_VALUE(metrics, member, value) \ do {short tmp = (value); (metrics)->member##_low = tmp & 0xff; \ (metrics)->member##_high = tmp >> 8;} while (0) diff --git a/src/mini-gmp.c b/src/mini-gmp.c index bf8a6164981..2e789a2dfcc 100644 --- a/src/mini-gmp.c +++ b/src/mini-gmp.c @@ -94,11 +94,13 @@ see https://www.gnu.org/licenses/. */ #define gmp_clz(count, x) do { \ mp_limb_t __clz_x = (x); \ - unsigned __clz_c; \ - for (__clz_c = 0; \ - (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ - __clz_c += 8) \ - __clz_x <<= 8; \ + unsigned __clz_c = 0; \ + int LOCAL_SHIFT_BITS = 8; \ + if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) \ + for (; \ + (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \ + __clz_c += 8) \ + { __clz_x <<= LOCAL_SHIFT_BITS; } \ for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \ __clz_x <<= 1; \ (count) = __clz_c; \ @@ -143,27 +145,27 @@ see https://www.gnu.org/licenses/. */ w1 = (mp_limb_t) (__ww >> LOCAL_GMP_LIMB_BITS); \ } \ else { \ - mp_limb_t __x0, __x1, __x2, __x3; \ - unsigned __ul, __vl, __uh, __vh; \ - mp_limb_t __u = (u), __v = (v); \ + mp_limb_t __x0, __x1, __x2, __x3; \ + unsigned __ul, __vl, __uh, __vh; \ + mp_limb_t __u = (u), __v = (v); \ \ - __ul = __u & GMP_LLIMB_MASK; \ - __uh = __u >> (GMP_LIMB_BITS / 2); \ - __vl = __v & GMP_LLIMB_MASK; \ - __vh = __v >> (GMP_LIMB_BITS / 2); \ + __ul = __u & GMP_LLIMB_MASK; \ + __uh = __u >> (GMP_LIMB_BITS / 2); \ + __vl = __v & GMP_LLIMB_MASK; \ + __vh = __v >> (GMP_LIMB_BITS / 2); \ \ - __x0 = (mp_limb_t) __ul * __vl; \ - __x1 = (mp_limb_t) __ul * __vh; \ - __x2 = (mp_limb_t) __uh * __vl; \ - __x3 = (mp_limb_t) __uh * __vh; \ + __x0 = (mp_limb_t) __ul * __vl; \ + __x1 = (mp_limb_t) __ul * __vh; \ + __x2 = (mp_limb_t) __uh * __vl; \ + __x3 = (mp_limb_t) __uh * __vh; \ \ - __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ - __x1 += __x2; /* but this indeed can */ \ - if (__x1 < __x2) /* did we get it? */ \ - __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ + __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \ + __x1 += __x2; /* but this indeed can */ \ + if (__x1 < __x2) /* did we get it? */ \ + __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \ \ - (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ - (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ + (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \ + (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \ } \ } while (0) @@ -768,91 +770,81 @@ mpn_neg (mp_ptr rp, mp_srcptr up, mp_size_t n) mp_limb_t mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) { - int GMP_LIMB_BITS_MUL_3 = GMP_LIMB_BITS * 3; - if (sizeof (unsigned) * CHAR_BIT > GMP_LIMB_BITS * 3) - { - return (((unsigned) 1 << GMP_LIMB_BITS_MUL_3) - 1) / - (((unsigned) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); - } - else if (GMP_ULONG_BITS > GMP_LIMB_BITS * 3) - { - return (((unsigned long) 1 << GMP_LIMB_BITS_MUL_3) - 1) / - (((unsigned long) u1 << GMP_LIMB_BITS_MUL_3 / 3) + u0); - } - else { - mp_limb_t r, p, m, ql; - unsigned ul, uh, qh; + mp_limb_t r, m; - assert (u1 >= GMP_LIMB_HIGHBIT); + { + mp_limb_t p, ql; + unsigned ul, uh, qh; - /* For notation, let b denote the half-limb base, so that B = b^2. - Split u1 = b uh + ul. */ - ul = u1 & GMP_LLIMB_MASK; - uh = u1 >> (GMP_LIMB_BITS / 2); + /* For notation, let b denote the half-limb base, so that B = b^2. + Split u1 = b uh + ul. */ + ul = u1 & GMP_LLIMB_MASK; + uh = u1 >> (GMP_LIMB_BITS / 2); - /* Approximation of the high half of quotient. Differs from the 2/1 - inverse of the half limb uh, since we have already subtracted - u0. */ - qh = ~u1 / uh; + /* Approximation of the high half of quotient. Differs from the 2/1 + inverse of the half limb uh, since we have already subtracted + u0. */ + qh = (u1 ^ GMP_LIMB_MAX) / uh; - /* Adjust to get a half-limb 3/2 inverse, i.e., we want + /* Adjust to get a half-limb 3/2 inverse, i.e., we want - qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u - = floor( (b (~u) + b-1) / u), + qh' = floor( (b^3 - 1) / u) - b = floor ((b^3 - b u - 1) / u + = floor( (b (~u) + b-1) / u), - and the remainder + and the remainder - r = b (~u) + b-1 - qh (b uh + ul) + r = b (~u) + b-1 - qh (b uh + ul) = b (~u - qh uh) + b-1 - qh ul - Subtraction of qh ul may underflow, which implies adjustments. - But by normalization, 2 u >= B > qh ul, so we need to adjust by - at most 2. - */ + Subtraction of qh ul may underflow, which implies adjustments. + But by normalization, 2 u >= B > qh ul, so we need to adjust by + at most 2. + */ - r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; + r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK; - p = (mp_limb_t) qh * ul; - /* Adjustment steps taken from udiv_qrnnd_c */ - if (r < p) - { - qh--; - r += u1; - if (r >= u1) /* i.e. we didn't get carry when adding to r */ - if (r < p) - { - qh--; - r += u1; - } - } - r -= p; + p = (mp_limb_t) qh * ul; + /* Adjustment steps taken from udiv_qrnnd_c */ + if (r < p) + { + qh--; + r += u1; + if (r >= u1) /* i.e. we didn't get carry when adding to r */ + if (r < p) + { + qh--; + r += u1; + } + } + r -= p; - /* Low half of the quotient is + /* Low half of the quotient is ql = floor ( (b r + b-1) / u1). - This is a 3/2 division (on half-limbs), for which qh is a - suitable inverse. */ + This is a 3/2 division (on half-limbs), for which qh is a + suitable inverse. */ - p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; - /* Unlike full-limb 3/2, we can add 1 without overflow. For this to - work, it is essential that ql is a full mp_limb_t. */ - ql = (p >> (GMP_LIMB_BITS / 2)) + 1; + p = (r >> (GMP_LIMB_BITS / 2)) * qh + r; + /* Unlike full-limb 3/2, we can add 1 without overflow. For this to + work, it is essential that ql is a full mp_limb_t. */ + ql = (p >> (GMP_LIMB_BITS / 2)) + 1; - /* By the 3/2 trick, we don't need the high half limb. */ - r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; + /* By the 3/2 trick, we don't need the high half limb. */ + r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1; - if (r >= (p << (GMP_LIMB_BITS / 2))) - { - ql--; - r += u1; - } - m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; - if (r >= u1) - { - m++; - r -= u1; - } + if (r >= (GMP_LIMB_MAX & (p << (GMP_LIMB_BITS / 2)))) + { + ql--; + r += u1; + } + m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql; + if (r >= u1) + { + m++; + r -= u1; + } + } /* Now m is the 2/1 inverse of u1. If u0 > 0, adjust it to become a 3/2 inverse. */ @@ -881,7 +873,6 @@ mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0) } return m; - } } struct gmp_div_inverse @@ -3332,7 +3323,7 @@ mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k) mpz_fac_ui (t, k); for (; k > 0; --k) - mpz_mul_ui (r, r, n--); + mpz_mul_ui (r, r, n--); mpz_divexact (r, r, t); mpz_clear (t); @@ -3990,13 +3981,18 @@ gmp_popcount_limb (mp_limb_t x) unsigned c; /* Do 16 bits at a time, to avoid limb-sized constants. */ - for (c = 0; x > 0; x >>= 16) + int LOCAL_SHIFT_BITS = 16; + for (c = 0; x > 0;) { unsigned w = x - ((x >> 1) & 0x5555); w = ((w >> 2) & 0x3333) + (w & 0x3333); w = (w >> 4) + w; w = ((w >> 8) & 0x000f) + (w & 0x000f); c += w; + if (GMP_LIMB_BITS > LOCAL_SHIFT_BITS) + x >>= LOCAL_SHIFT_BITS; + else + x = 0; } return c; } @@ -4503,10 +4499,15 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian, limb = u->_mp_d[un-1]; assert (limb != 0); - k = 0; - do { - k++; limb >>= CHAR_BIT; - } while (limb != 0); + k = (GMP_LIMB_BITS <= CHAR_BIT); + if (!k) + { + do { + int LOCAL_CHAR_BIT = CHAR_BIT; + k++; limb >>= LOCAL_CHAR_BIT; + } while (limb != 0); + } + /* else limb = 0; */ count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size; @@ -4535,17 +4536,28 @@ mpz_export (void *r, size_t *countp, int order, size_t size, int endian, for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step) { size_t j; - for (j = 0; j < size; j++, p -= (ptrdiff_t) endian) + for (j = 0; j < size; ++j, p -= (ptrdiff_t) endian) { - if (bytes == 0) + if (sizeof (mp_limb_t) == 1) { if (i < un) - limb = u->_mp_d[i++]; - bytes = sizeof (mp_limb_t); + *p = u->_mp_d[i++]; + else + *p = 0; + } + else + { + int LOCAL_CHAR_BIT = CHAR_BIT; + if (bytes == 0) + { + if (i < un) + limb = u->_mp_d[i++]; + bytes = sizeof (mp_limb_t); + } + *p = limb; + limb >>= LOCAL_CHAR_BIT; + bytes--; } - *p = limb; - limb >>= CHAR_BIT; - bytes--; } } assert (i == un); diff --git a/src/mini-gmp.h b/src/mini-gmp.h index 27e0c0671a2..7cce3f7a328 100644 --- a/src/mini-gmp.h +++ b/src/mini-gmp.h @@ -1,6 +1,6 @@ /* mini-gmp, a minimalistic implementation of a GNU GMP subset. -Copyright 2011-2015, 2017 Free Software Foundation, Inc. +Copyright 2011-2015, 2017, 2019 Free Software Foundation, Inc. This file is part of the GNU MP Library. @@ -53,7 +53,11 @@ void mp_get_memory_functions (void *(**) (size_t), void *(**) (void *, size_t, size_t), void (**) (void *, size_t)); -typedef unsigned long mp_limb_t; +#ifndef MINI_GMP_LIMB_TYPE +#define MINI_GMP_LIMB_TYPE long +#endif + +typedef unsigned MINI_GMP_LIMB_TYPE mp_limb_t; typedef long mp_size_t; typedef unsigned long mp_bitcnt_t; diff --git a/src/minibuf.c b/src/minibuf.c index b837cc53eb9..9d870ce3640 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -414,12 +414,13 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, if (!enable_recursive_minibuffers && minibuf_level > 0) { + Lisp_Object str + = build_string ("Command attempted to use minibuffer while in minibuffer"); if (EQ (selected_window, minibuf_window)) - error ("Command attempted to use minibuffer while in minibuffer"); + Fsignal (Quser_error, (list1 (str))); else /* If we're in another window, cancel the minibuffer that's active. */ - Fthrow (Qexit, - build_string ("Command attempted to use minibuffer while in minibuffer")); + Fthrow (Qexit, str); } if ((noninteractive diff --git a/src/module-env-25.h b/src/module-env-25.h index d8f8eb68119..01ce65e9148 100644 --- a/src/module-env-25.h +++ b/src/module-env-25.h @@ -6,12 +6,10 @@ /* Memory management. */ - emacs_value (*make_global_ref) (emacs_env *env, - emacs_value any_reference) + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - void (*free_global_ref) (emacs_env *env, - emacs_value global_reference) + void (*free_global_ref) (emacs_env *env, emacs_value global_value) EMACS_ATTRIBUTE_NONNULL(1); /* Non-local exit handling. */ @@ -23,19 +21,15 @@ EMACS_ATTRIBUTE_NONNULL(1); enum emacs_funcall_exit (*non_local_exit_get) - (emacs_env *env, - emacs_value *non_local_exit_symbol_out, - emacs_value *non_local_exit_data_out) + (emacs_env *env, emacs_value *symbol, emacs_value *data) EMACS_ATTRIBUTE_NONNULL(1, 2, 3); void (*non_local_exit_signal) (emacs_env *env, - emacs_value non_local_exit_symbol, - emacs_value non_local_exit_data) + emacs_value symbol, emacs_value data) EMACS_ATTRIBUTE_NONNULL(1); void (*non_local_exit_throw) (emacs_env *env, - emacs_value tag, - emacs_value value) + emacs_value tag, emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); /* Function registration. */ @@ -43,48 +37,46 @@ emacs_value (*make_function) (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_value (*function) (emacs_env *env, - ptrdiff_t nargs, - emacs_value args[], - void *) + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1), - const char *documentation, + const char *docstring, void *data) EMACS_ATTRIBUTE_NONNULL(1, 4); emacs_value (*funcall) (emacs_env *env, - emacs_value function, + emacs_value func, ptrdiff_t nargs, - emacs_value args[]) + emacs_value* args) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*intern) (emacs_env *env, - const char *symbol_name) + emacs_value (*intern) (emacs_env *env, const char *name) EMACS_ATTRIBUTE_NONNULL(1, 2); /* Type conversion. */ - emacs_value (*type_of) (emacs_env *env, - emacs_value value) + emacs_value (*type_of) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - bool (*is_not_nil) (emacs_env *env, emacs_value value) + bool (*is_not_nil) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) EMACS_ATTRIBUTE_NONNULL(1); - intmax_t (*extract_integer) (emacs_env *env, emacs_value value) + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*make_integer) (emacs_env *env, intmax_t value) + emacs_value (*make_integer) (emacs_env *env, intmax_t n) EMACS_ATTRIBUTE_NONNULL(1); - double (*extract_float) (emacs_env *env, emacs_value value) + double (*extract_float) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - emacs_value (*make_float) (emacs_env *env, double value) + emacs_value (*make_float) (emacs_env *env, double d) EMACS_ATTRIBUTE_NONNULL(1); /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 @@ -101,13 +93,13 @@ bool (*copy_string_contents) (emacs_env *env, emacs_value value, - char *buffer, - ptrdiff_t *size_inout) + char *buf, + ptrdiff_t *len) EMACS_ATTRIBUTE_NONNULL(1, 4); /* Create a Lisp string from a utf8 encoded string. */ emacs_value (*make_string) (emacs_env *env, - const char *contents, ptrdiff_t length) + const char *str, ptrdiff_t len) EMACS_ATTRIBUTE_NONNULL(1, 2); /* Embedded pointer type. */ @@ -116,25 +108,24 @@ void *ptr) EMACS_ATTRIBUTE_NONNULL(1); - void *(*get_user_ptr) (emacs_env *env, emacs_value uptr) + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_ptr) (emacs_env *env, emacs_value uptr, void *ptr) + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) EMACS_ATTRIBUTE_NONNULL(1); void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_finalizer) (emacs_env *env, - emacs_value uptr, + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, void (*fin) (void *) EMACS_NOEXCEPT) EMACS_ATTRIBUTE_NONNULL(1); /* Vector functions. */ - emacs_value (*vec_get) (emacs_env *env, emacs_value vec, ptrdiff_t i) + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) EMACS_ATTRIBUTE_NONNULL(1); - void (*vec_set) (emacs_env *env, emacs_value vec, ptrdiff_t i, - emacs_value val) + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec) + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) EMACS_ATTRIBUTE_NONNULL(1); diff --git a/src/module-env-27.h b/src/module-env-27.h index 0fe2557d71b..9ef3c8b33bb 100644 --- a/src/module-env-27.h +++ b/src/module-env-27.h @@ -3,7 +3,7 @@ enum emacs_process_input_result (*process_input) (emacs_env *env) EMACS_ATTRIBUTE_NONNULL (1); - struct timespec (*extract_time) (emacs_env *env, emacs_value value) + struct timespec (*extract_time) (emacs_env *env, emacs_value arg) EMACS_ATTRIBUTE_NONNULL (1); emacs_value (*make_time) (emacs_env *env, struct timespec time) diff --git a/src/module-env-28.h b/src/module-env-28.h new file mode 100644 index 00000000000..a2479a8f744 --- /dev/null +++ b/src/module-env-28.h @@ -0,0 +1,11 @@ + /* Add module environment functions newly added in Emacs 28 here. + Before Emacs 28 is released, remove this comment and start + module-env-29.h on the master branch. */ + + void (*(*EMACS_ATTRIBUTE_NONNULL (1) + get_function_finalizer) (emacs_env *env, + emacs_value arg)) (void *) EMACS_NOEXCEPT; + + void (*set_function_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL (1); diff --git a/src/msdos.c b/src/msdos.c index 6a89178a6e9..a09b3ba7924 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1794,7 +1794,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_fixnum (27); /* RE Emacs version */ + Vwindow_system_version = make_fixnum (28); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM diff --git a/src/nsfns.m b/src/nsfns.m index 0f879fe390c..cbde93b3f10 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -255,7 +255,10 @@ ns_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) [col getRed: &r green: &g blue: &b alpha: &alpha]; FRAME_FOREGROUND_PIXEL (f) = - ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff)); + ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), + (unsigned long) (r * 0xff), + (unsigned long) (g * 0xff), + (unsigned long) (b * 0xff)); if (FRAME_NS_VIEW (f)) { @@ -284,19 +287,16 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) error ("Unknown color"); } - /* Clear the frame; in some instances the NS-internal GC appears not - to update, or it does update and cannot clear old text - properly. */ - if (FRAME_VISIBLE_P (f)) - ns_clear_frame (f); - [col retain]; [f->output_data.ns->background_color release]; f->output_data.ns->background_color = col; [col getRed: &r green: &g blue: &b alpha: &alpha]; FRAME_BACKGROUND_PIXEL (f) = - ARGB_TO_ULONG ((int)(alpha*0xff), (int)(r*0xff), (int)(g*0xff), (int)(b*0xff)); + ARGB_TO_ULONG ((unsigned long) (alpha * 0xff), + (unsigned long) (r * 0xff), + (unsigned long) (g * 0xff), + (unsigned long) (b * 0xff)); if (view != nil) { @@ -318,7 +318,10 @@ ns_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } if (FRAME_VISIBLE_P (f)) - SET_FRAME_GARBAGED (f); + { + SET_FRAME_GARBAGED (f); + ns_clear_frame (f); + } } unblock_input (); } @@ -1271,14 +1274,20 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, #ifdef NS_IMPL_COCOA tem = gui_display_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL, RES_TYPE_SYMBOL); - FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark) - ? ns_appearance_vibrant_dark : ns_appearance_aqua; - store_frame_param (f, Qns_appearance, tem); + if (EQ (tem, Qdark)) + FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; + else if (EQ (tem, Qlight)) + FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; + else + FRAME_NS_APPEARANCE (f) = ns_appearance_system_default; + store_frame_param (f, Qns_appearance, + (!NILP (tem) && !EQ (tem, Qunbound)) ? tem : Qnil); tem = gui_display_get_arg (dpyinfo, parms, Qns_transparent_titlebar, NULL, NULL, RES_TYPE_BOOLEAN); FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound); - store_frame_param (f, Qns_transparent_titlebar, tem); + store_frame_param (f, Qns_transparent_titlebar, + FRAME_NS_TRANSPARENT_TITLEBAR (f) ? Qt : Qnil); #endif parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, @@ -3112,6 +3121,7 @@ syms_of_nsfns (void) DEFSYM (Qframe_title_format, "frame-title-format"); DEFSYM (Qicon_title_format, "icon-title-format"); DEFSYM (Qdark, "dark"); + DEFSYM (Qlight, "light"); DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist, doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. diff --git a/src/nsimage.m b/src/nsimage.m index fa1e98b8848..3cccc984ca9 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -407,9 +407,10 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) if (pixmapData[0] != NULL) { int loc = x + y * [self size].width; - return (pixmapData[3][loc] << 24) /* alpha */ - | (pixmapData[0][loc] << 16) | (pixmapData[1][loc] << 8) - | (pixmapData[2][loc]); + return (((unsigned long) pixmapData[3][loc] << 24) /* alpha */ + | ((unsigned long) pixmapData[0][loc] << 16) + | ((unsigned long) pixmapData[1][loc] << 8) + | (unsigned long) pixmapData[2][loc]); } else { diff --git a/src/nsterm.h b/src/nsterm.h index f68c3246a70..7c6197f1288 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -417,6 +417,9 @@ typedef id instancetype; int maximized_width, maximized_height; NSWindow *nonfs_window; BOOL fs_is_native; +#ifdef NS_IMPL_COCOA + CGContextRef drawingBuffer; +#endif @public struct frame *emacsframe; int rows, cols; @@ -457,7 +460,13 @@ typedef id instancetype; #endif - (int)fullscreenState; -/* Non-notification versions of NSView methods. Used for direct calls. */ +#ifdef NS_IMPL_COCOA +- (void)focusOnDrawingBuffer; +#endif +- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect; +- (void)createDrawingBuffer; + +/* Non-notification versions of NSView methods. Used for direct calls. */ - (void)windowWillEnterFullScreen; - (void)windowDidEnterFullScreen; - (void)windowWillExitFullScreen; @@ -471,6 +480,8 @@ typedef id instancetype; { NSPoint grabOffset; } + +- (void)setAppearance; @end diff --git a/src/nsterm.m b/src/nsterm.m index ed2d82ceaef..c0535825eee 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -287,7 +287,10 @@ struct ns_display_info *x_display_list; /* Chain of existing displays */ long context_menu_value = 0; /* display update */ +static struct frame *ns_updating_frame; +static NSView *focus_view = NULL; static int ns_window_num = 0; +static BOOL gsaved = NO; static BOOL ns_fake_keydown = NO; #ifdef NS_IMPL_COCOA static BOOL ns_menu_bar_is_hidden = NO; @@ -1097,13 +1100,12 @@ ns_update_begin (struct frame *f) external (RIF) call; whole frame, called before gui_update_window_begin -------------------------------------------------------------------------- */ { -#ifdef NS_IMPL_COCOA EmacsView *view = FRAME_NS_VIEW (f); - NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_begin"); ns_update_auto_hide_menu_bar (); +#ifdef NS_IMPL_COCOA if ([view isFullscreen] && [view fsIsNative]) { // Fix reappearing tool bar in fullscreen for Mac OS X 10.7 @@ -1113,6 +1115,13 @@ ns_update_begin (struct frame *f) [toolbar setVisible: tbar_visible]; } #endif + + ns_updating_frame = f; +#ifdef NS_IMPL_COCOA + [view focusOnDrawingBuffer]; +#else + [view lockFocus]; +#endif } @@ -1123,57 +1132,123 @@ ns_update_end (struct frame *f) external (RIF) call; for whole frame, called after gui_update_window_end -------------------------------------------------------------------------- */ { + EmacsView *view = FRAME_NS_VIEW (f); + NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_update_end"); /* if (f == MOUSE_HL_INFO (f)->mouse_face_mouse_frame) */ MOUSE_HL_INFO (f)->mouse_face_defer = 0; -} +#ifdef NS_IMPL_COCOA + [NSGraphicsContext setCurrentContext:nil]; +#else + block_input (); -static BOOL -ns_clip_to_rect (struct frame *f, NSRect *r, int n) + [view unlockFocus]; + [[view window] flushWindow]; + + unblock_input (); +#endif + ns_updating_frame = NULL; +} + +static void +ns_focus (struct frame *f, NSRect *r, int n) /* -------------------------------------------------------------------------- - Clip the drawing area to rectangle r in frame f. If drawing is not - currently possible mark r as dirty and return NO, otherwise return - YES. + Internal: Focus on given frame. During small local updates this is used to + draw, however during large updates, ns_update_begin and ns_update_end are + called to wrap the whole thing, in which case these calls are stubbed out. + Except, on GNUstep, we accumulate the rectangle being drawn into, because + the back end won't do this automatically, and will just end up flushing + the entire window. -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_clip_to_rect"); - if (r) + EmacsView *view = FRAME_NS_VIEW (f); + + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_focus"); + if (r != NULL) { NSTRACE_RECT ("r", *r); + } - if ([NSView focusView] == FRAME_NS_VIEW (f)) + if (f != ns_updating_frame) +#ifdef NS_IMPL_COCOA + [view focusOnDrawingBuffer]; +#else + { + if (view != focus_view) { - [[NSGraphicsContext currentContext] saveGraphicsState]; - if (n == 2) - NSRectClipList (r, 2); - else - NSRectClip (*r); + if (focus_view != NULL) + { + [focus_view unlockFocus]; + [[focus_view window] flushWindow]; + } - return YES; + if (view) + [view lockFocus]; + focus_view = view; } + } +#endif + + /* clipping */ + if (r) + { +#ifdef NS_IMPL_COCOA + int i; + for (i = 0 ; i < n ; i++) + [view setNeedsDisplayInRect:r[i]]; +#endif + + [[NSGraphicsContext currentContext] saveGraphicsState]; + if (n == 2) + NSRectClipList (r, 2); else + NSRectClip (*r); + gsaved = YES; + } +} + + +static void +ns_unfocus (struct frame *f) +/* -------------------------------------------------------------------------- + Internal: Remove focus on given frame + -------------------------------------------------------------------------- */ +{ + NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_unfocus"); + + if (gsaved) + { + [[NSGraphicsContext currentContext] restoreGraphicsState]; + gsaved = NO; + } + +#ifdef NS_IMPL_GNUSTEP + if (f != ns_updating_frame) + { + if (focus_view != NULL) { - NSView *view = FRAME_NS_VIEW (f); - int i; - for (i = 0 ; i < n ; i++) - [view setNeedsDisplayInRect:r[i]]; + [focus_view unlockFocus]; + [[focus_view window] flushWindow]; + focus_view = NULL; } } - - return NO; +#endif } static void -ns_reset_clipping (struct frame *f) -/* Internal: Restore the previous graphics state, unsetting any - clipping areas. */ +ns_clip_to_row (struct window *w, struct glyph_row *row, + enum glyph_row_area area, BOOL gc) +/* -------------------------------------------------------------------------- + Internal (but parallels other terms): Focus drawing on given row + -------------------------------------------------------------------------- */ { - NSTRACE_WHEN (NSTRACE_GROUP_FOCUS, "ns_reset_clipping"); + struct frame *f = XFRAME (WINDOW_FRAME (w)); + NSRect clip_rect = ns_row_rect (w, row, area); - [[NSGraphicsContext currentContext] restoreGraphicsState]; + ns_focus (f, &clip_rect, 1); } @@ -2026,17 +2101,13 @@ ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value return; if (EQ (new_value, Qdark)) - { - window.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameVibrantDark]; - FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; - } + FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; + else if (EQ (new_value, Qlight)) + FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; else - { - window.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameAqua]; - FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; - } + FRAME_NS_APPEARANCE (f) = ns_appearance_system_default; + + [window setAppearance]; #endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ } @@ -2302,8 +2373,10 @@ ns_color_index_to_rgba(int idx, struct frame *f) EmacsCGFloat r, g, b, a; [col getRed: &r green: &g blue: &b alpha: &a]; - return ARGB_TO_ULONG((int)(a*255), - (int)(r*255), (int)(g*255), (int)(b*255)); + return ARGB_TO_ULONG((unsigned long) (a * 255), + (unsigned long) (r * 255), + (unsigned long) (g * 255), + (unsigned long) (b * 255)); } void @@ -2323,8 +2396,10 @@ ns_query_color(void *col, Emacs_Color *color_def, bool setPixel) if (setPixel == YES) color_def->pixel - = ARGB_TO_ULONG((int)(a*255), - (int)(r*255), (int)(g*255), (int)(b*255)); + = ARGB_TO_ULONG((unsigned long) (a * 255), + (unsigned long) (r * 255), + (unsigned long) (g * 255), + (unsigned long) (b * 255)); } bool @@ -2770,16 +2845,16 @@ ns_clear_frame (struct frame *f) r = [view bounds]; block_input (); - if (ns_clip_to_rect (f, &r, 1)) - { - [ns_lookup_indexed_color (NS_FACE_BACKGROUND - (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; - NSRectFill (r); - ns_reset_clipping (f); - - /* as of 2006/11 or so this is now needed */ - ns_redraw_scroll_bars (f); - } + ns_focus (f, &r, 1); + [ns_lookup_indexed_color (NS_FACE_BACKGROUND + (FACE_FROM_ID (f, DEFAULT_FACE_ID)), f) set]; + NSRectFill (r); + ns_unfocus (f); + + /* as of 2006/11 or so this is now needed */ + /* FIXME: I don't see any reason for this and removing it makes no + difference here. Do we need it for GNUstep? */ + //ns_redraw_scroll_bars (f); unblock_input (); } @@ -2800,46 +2875,15 @@ ns_clear_frame_area (struct frame *f, int x, int y, int width, int height) NSTRACE_WHEN (NSTRACE_GROUP_UPDATES, "ns_clear_frame_area"); r = NSIntersectionRect (r, [view frame]); - if (ns_clip_to_rect (f, &r, 1)) - { - [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; + ns_focus (f, &r, 1); + [ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), f) set]; - NSRectFill (r); + NSRectFill (r); - ns_reset_clipping (f); - } + ns_unfocus (f); + return; } -static void -ns_copy_bits (struct frame *f, NSRect src, NSRect dest) -{ - NSSize delta = NSMakeSize (dest.origin.x - src.origin.x, - dest.origin.y - src.origin.y); - NSTRACE ("ns_copy_bits"); - - if (FRAME_NS_VIEW (f)) - { - hide_bell(); // Ensure the bell image isn't scrolled. - - /* FIXME: scrollRect:by: is deprecated in macOS 10.14. There is - no obvious replacement so we may have to come up with our own. */ - [FRAME_NS_VIEW (f) scrollRect: src by: delta]; - -#ifdef NS_IMPL_COCOA - /* As far as I can tell from the documentation, scrollRect:by:, - above, should copy the dirty rectangles from our source - rectangle to our destination, however it appears it clips the - operation to src. As a result we need to use - translateRectsNeedingDisplayInRect:by: below, and we have to - union src and dest so it can pick up the dirty rectangles, - and place them, as it also clips to the rectangle. - - FIXME: We need a GNUstep equivalent. */ - [FRAME_NS_VIEW (f) translateRectsNeedingDisplayInRect:NSUnionRect (src, dest) - by:delta]; -#endif - } -} static void ns_scroll_run (struct window *w, struct run *run) @@ -2892,8 +2936,12 @@ ns_scroll_run (struct window *w, struct run *run) { NSRect srcRect = NSMakeRect (x, from_y, width, height); NSRect dstRect = NSMakeRect (x, to_y, width, height); + EmacsView *view = FRAME_NS_VIEW (f); - ns_copy_bits (f, srcRect , dstRect); + [view copyRect:srcRect to:dstRect]; +#ifdef NS_IMPL_COCOA + [view setNeedsDisplayInRect:srcRect]; +#endif } unblock_input (); @@ -2947,20 +2995,12 @@ ns_shift_glyphs_for_insert (struct frame *f, External (RIF): copy an area horizontally, don't worry about clearing src -------------------------------------------------------------------------- */ { - //NSRect srcRect = NSMakeRect (x, y, width, height); + NSRect srcRect = NSMakeRect (x, y, width, height); NSRect dstRect = NSMakeRect (x+shift_by, y, width, height); NSTRACE ("ns_shift_glyphs_for_insert"); - /* This doesn't work now as we copy the "bits" before we've had a - chance to actually draw any changes to the screen. This means in - certain circumstances we end up with copies of the cursor all - over the place. Just mark the area dirty so it is redrawn later. - - FIXME: Work out how to do this properly. */ - // ns_copy_bits (f, srcRect, dstRect); - - [FRAME_NS_VIEW (f) setNeedsDisplayInRect:dstRect]; + [FRAME_NS_VIEW (f) copyRect:srcRect to:dstRect]; } @@ -3080,66 +3120,64 @@ ns_draw_fringe_bitmap (struct window *w, struct glyph_row *row, /* The visible portion of imageRect will always be contained within clearRect. */ - if (ns_clip_to_rect (f, &clearRect, 1)) + ns_focus (f, &clearRect, 1); + if (! NSIsEmptyRect (clearRect)) { - if (! NSIsEmptyRect (clearRect)) - { - NSTRACE_RECT ("clearRect", clearRect); + NSTRACE_RECT ("clearRect", clearRect); - [ns_lookup_indexed_color(face->background, f) set]; - NSRectFill (clearRect); - } + [ns_lookup_indexed_color(face->background, f) set]; + NSRectFill (clearRect); + } - if (p->which) - { - EmacsImage *img = bimgs[p->which - 1]; + if (p->which) + { + EmacsImage *img = bimgs[p->which - 1]; - if (!img) - { - // Note: For "periodic" images, allocate one EmacsImage for - // the base image, and use it for all dh:s. - unsigned short *bits = p->bits; - int full_height = p->h + p->dh; - int i; - unsigned char *cbits = xmalloc (full_height); - - for (i = 0; i < full_height; i++) - cbits[i] = bits[i]; - img = [[EmacsImage alloc] initFromXBM: cbits width: 8 - height: full_height - fg: 0 bg: 0 - reverseBytes: NO]; - bimgs[p->which - 1] = img; - xfree (cbits); - } + if (!img) + { + // Note: For "periodic" images, allocate one EmacsImage for + // the base image, and use it for all dh:s. + unsigned short *bits = p->bits; + int full_height = p->h + p->dh; + int i; + unsigned char *cbits = xmalloc (full_height); + + for (i = 0; i < full_height; i++) + cbits[i] = bits[i]; + img = [[EmacsImage alloc] initFromXBM: cbits width: 8 + height: full_height + fg: 0 bg: 0 + reverseBytes: NO]; + bimgs[p->which - 1] = img; + xfree (cbits); + } - { - NSColor *bm_color; - if (!p->cursor_p) - bm_color = ns_lookup_indexed_color(face->foreground, f); - else if (p->overlay_p) - bm_color = ns_lookup_indexed_color(face->background, f); - else - bm_color = f->output_data.ns->cursor_color; - [img setXBMColor: bm_color]; - } + { + NSColor *bm_color; + if (!p->cursor_p) + bm_color = ns_lookup_indexed_color(face->foreground, f); + else if (p->overlay_p) + bm_color = ns_lookup_indexed_color(face->background, f); + else + bm_color = f->output_data.ns->cursor_color; + [img setXBMColor: bm_color]; + } - // Note: For periodic images, the full image height is "h + hd". - // By using the height h, a suitable part of the image is used. - NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); + // Note: For periodic images, the full image height is "h + hd". + // By using the height h, a suitable part of the image is used. + NSRect fromRect = NSMakeRect(0, 0, p->wd, p->h); - NSTRACE_RECT ("fromRect", fromRect); + NSTRACE_RECT ("fromRect", fromRect); - [img drawInRect: imageRect - fromRect: fromRect - operation: NSCompositingOperationSourceOver - fraction: 1.0 - respectFlipped: YES - hints: nil]; - } - ns_reset_clipping (f); + [img drawInRect: imageRect + fromRect: fromRect + operation: NSCompositingOperationSourceOver + fraction: 1.0 + respectFlipped: YES + hints: nil]; } + ns_unfocus (f); } @@ -3224,60 +3262,52 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, /* Prevent the cursor from being drawn outside the text area. */ r = NSIntersectionRect (r, ns_row_rect (w, glyph_row, TEXT_AREA)); - if (ns_clip_to_rect (f, &r, 1)) + face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); + if (face && NS_FACE_BACKGROUND (face) + == ns_index_color (FRAME_CURSOR_COLOR (f), f)) { - face = FACE_FROM_ID_OR_NULL (f, phys_cursor_glyph->face_id); - if (face && NS_FACE_BACKGROUND (face) - == ns_index_color (FRAME_CURSOR_COLOR (f), f)) - { - [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; - hollow_color = FRAME_CURSOR_COLOR (f); - } - else - [FRAME_CURSOR_COLOR (f) set]; - - switch (cursor_type) - { - case DEFAULT_CURSOR: - case NO_CURSOR: - break; - case FILLED_BOX_CURSOR: - NSRectFill (r); - break; - case HOLLOW_BOX_CURSOR: - NSRectFill (r); - [hollow_color set]; - NSRectFill (NSInsetRect (r, 1, 1)); - [FRAME_CURSOR_COLOR (f) set]; - break; - case HBAR_CURSOR: - NSRectFill (r); - break; - case BAR_CURSOR: - s = r; - /* If the character under cursor is R2L, draw the bar cursor - on the right of its glyph, rather than on the left. */ - cursor_glyph = get_phys_cursor_glyph (w); - if ((cursor_glyph->resolved_level & 1) != 0) - s.origin.x += cursor_glyph->pixel_width - s.size.width; - - NSRectFill (s); - break; - } + [ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), f) set]; + hollow_color = FRAME_CURSOR_COLOR (f); + } + else + [FRAME_CURSOR_COLOR (f) set]; - /* Draw the character under the cursor. Other terms only draw - the character on top of box cursors, so do the same here. */ - if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + ns_focus (f, &r, 1); - ns_reset_clipping (f); - } - else if (! redisplaying_p) + switch (cursor_type) { - /* If this function is called outside redisplay, it probably - means we need an immediate update. */ - [FRAME_NS_VIEW (f) display]; + case DEFAULT_CURSOR: + case NO_CURSOR: + break; + case FILLED_BOX_CURSOR: + NSRectFill (r); + break; + case HOLLOW_BOX_CURSOR: + NSRectFill (r); + [hollow_color set]; + NSRectFill (NSInsetRect (r, 1, 1)); + [FRAME_CURSOR_COLOR (f) set]; + break; + case HBAR_CURSOR: + NSRectFill (r); + break; + case BAR_CURSOR: + s = r; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + cursor_glyph = get_phys_cursor_glyph (w); + if ((cursor_glyph->resolved_level & 1) != 0) + s.origin.x += cursor_glyph->pixel_width - s.size.width; + + NSRectFill (s); + break; } + ns_unfocus (f); + + /* Draw the character under the cursor. Other terms only draw + the character on top of box cursors, so do the same here. */ + if (cursor_type == FILLED_BOX_CURSOR || cursor_type == HOLLOW_BOX_CURSOR) + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); } @@ -3295,14 +3325,12 @@ ns_draw_vertical_window_border (struct window *w, int x, int y0, int y1) face = FACE_FROM_ID_OR_NULL (f, VERTICAL_BORDER_FACE_ID); - if (ns_clip_to_rect (f, &r, 1)) - { - if (face) - [ns_lookup_indexed_color(face->foreground, f) set]; + ns_focus (f, &r, 1); + if (face) + [ns_lookup_indexed_color(face->foreground, f) set]; - NSRectFill(r); - ns_reset_clipping (f); - } + NSRectFill(r); + ns_unfocus (f); } @@ -3329,42 +3357,42 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) NSTRACE ("ns_draw_window_divider"); - if (ns_clip_to_rect (f, ÷r, 1)) - { - if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) - /* A vertical divider, at least three pixels wide: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); - } - else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) - /* A horizontal divider, at least three pixels high: Draw first and - last pixels differently. */ - { - [ns_lookup_indexed_color(color_first, f) set]; - NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); - [ns_lookup_indexed_color(color_last, f) set]; - NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); - } - else - { - /* In any other case do not draw the first and last pixels - differently. */ - [ns_lookup_indexed_color(color, f) set]; - NSRectFill(divider); - } + ns_focus (f, ÷r, 1); - ns_reset_clipping (f); + if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3)) + /* A vertical divider, at least three pixels wide: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0)); + } + else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3)) + /* A horizontal divider, at least three pixels high: Draw first and + last pixels differently. */ + { + [ns_lookup_indexed_color(color_first, f) set]; + NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1)); + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2)); + [ns_lookup_indexed_color(color_last, f) set]; + NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1)); } + else + { + /* In any other case do not draw the first and last pixels + differently. */ + [ns_lookup_indexed_color(color, f) set]; + NSRectFill(divider); + } + + ns_unfocus (f); } + static void ns_show_hourglass (struct frame *f) { @@ -3888,15 +3916,22 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) [[NSGraphicsContext currentContext] saveGraphicsState]; - /* Because of the transforms it's far too difficult to work out - what portion of the original, untransformed, image will be - drawn, so the clipping area will ensure we draw only the - correct bit. */ + /* Because of the transforms it's difficult to work out what + portion of the original, untransformed, image will be drawn, + so the clipping area will ensure we draw only the correct + bit. */ NSRectClip (dr); [setOrigin translateXBy:x - s->slice.x yBy:y - s->slice.y]; [setOrigin concat]; - [img->transform concat]; + + NSAffineTransform *doTransform = [NSAffineTransform transform]; + + /* ImageMagick images don't have transforms. */ + if (img->transform) + [doTransform appendTransform:img->transform]; + + [doTransform concat]; [img drawInRect:ir fromRect:ir operation:NSCompositingOperationSourceOver @@ -3969,6 +4004,7 @@ static void ns_dumpglyphs_stretch (struct glyph_string *s) { NSRect r[2]; + NSRect glyphRect; int n, i; struct face *face; NSColor *fgCol, *bgCol; @@ -3976,82 +4012,57 @@ ns_dumpglyphs_stretch (struct glyph_string *s) if (!s->background_filled_p) { n = ns_get_glyph_string_clip_rect (s, r); + ns_focus (s->f, r, n); - if (ns_clip_to_rect (s->f, r, n)) + if (s->hl == DRAW_MOUSE_FACE) { - /* FIXME: Why are we reusing the clipping rectangles? The - other terms don't appear to do anything like this. */ - *r = NSMakeRect (s->x, s->y, s->background_width, s->height); + face = FACE_FROM_ID_OR_NULL (s->f, + MOUSE_HL_INFO (s->f)->mouse_face_face_id); + if (!face) + face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); + } + else + face = FACE_FROM_ID (s->f, s->first_glyph->face_id); - if (s->hl == DRAW_MOUSE_FACE) - { - face = FACE_FROM_ID_OR_NULL (s->f, - MOUSE_HL_INFO (s->f)->mouse_face_face_id); - if (!face) - face = FACE_FROM_ID (s->f, MOUSE_FACE_ID); - } - else - face = FACE_FROM_ID (s->f, s->first_glyph->face_id); + bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); + fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); - bgCol = ns_lookup_indexed_color (NS_FACE_BACKGROUND (face), s->f); - fgCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f); + glyphRect = NSMakeRect (s->x, s->y, s->background_width, s->height); - for (i = 0; i < n; ++i) - { - if (!s->row->full_width_p) - { - int overrun, leftoverrun; - - /* truncate to avoid overwriting fringe and/or scrollbar */ - overrun = max (0, (s->x + s->background_width) - - (WINDOW_BOX_RIGHT_EDGE_X (s->w) - - WINDOW_RIGHT_FRINGE_WIDTH (s->w))); - r[i].size.width -= overrun; - - /* truncate to avoid overwriting to left of the window box */ - leftoverrun = (WINDOW_BOX_LEFT_EDGE_X (s->w) - + WINDOW_LEFT_FRINGE_WIDTH (s->w)) - s->x; - - if (leftoverrun > 0) - { - r[i].origin.x += leftoverrun; - r[i].size.width -= leftoverrun; - } - } + [bgCol set]; - [bgCol set]; + /* NOTE: under NS this is NOT used to draw cursors, but we must avoid + overwriting cursor (usually when cursor on a tab) */ + if (s->hl == DRAW_CURSOR) + { + CGFloat x, width; - /* NOTE: under NS this is NOT used to draw cursors, but we must avoid - overwriting cursor (usually when cursor on a tab). */ - if (s->hl == DRAW_CURSOR) - { - CGFloat x, width; + /* FIXME: This looks like it will only work for left to + right languages. */ + x = NSMinX (glyphRect); + width = s->w->phys_cursor_width; + glyphRect.size.width -= width; + glyphRect.origin.x += width; - x = r[i].origin.x; - width = s->w->phys_cursor_width; - r[i].size.width -= width; - r[i].origin.x += width; + NSRectFill (glyphRect); - NSRectFill (r[i]); + /* Draw overlining, etc. on the cursor. */ + if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) + ns_draw_text_decoration (s, face, bgCol, width, x); + else + ns_draw_text_decoration (s, face, fgCol, width, x); + } + else + { + NSRectFill (glyphRect); + } - /* Draw overlining, etc. on the cursor. */ - if (s->w->phys_cursor_type == FILLED_BOX_CURSOR) - ns_draw_text_decoration (s, face, bgCol, width, x); - else - ns_draw_text_decoration (s, face, fgCol, width, x); - } - else - { - NSRectFill (r[i]); - } + /* Draw overlining, etc. on the stretch glyph (or the part + of the stretch glyph after the cursor). */ + ns_draw_text_decoration (s, face, fgCol, NSWidth (glyphRect), + NSMinX (glyphRect)); - /* Draw overlining, etc. on the stretch glyph (or the part - of the stretch glyph after the cursor). */ - ns_draw_text_decoration (s, face, fgCol, r[i].size.width, - r[i].origin.x); - } - ns_reset_clipping (s->f); - } + ns_unfocus (s->f); s->background_filled_p = 1; } } @@ -4201,11 +4212,9 @@ ns_draw_glyph_string (struct glyph_string *s) if (next->first_glyph->type != STRETCH_GLYPH) { n = ns_get_glyph_string_clip_rect (s->next, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_maybe_dumpglyphs_background (s->next, 1); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_maybe_dumpglyphs_background (s->next, 1); + ns_unfocus (s->f); } else { @@ -4220,12 +4229,10 @@ ns_draw_glyph_string (struct glyph_string *s) || s->first_glyph->type == COMPOSITE_GLYPH)) { n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_maybe_dumpglyphs_background (s, 1); - ns_dumpglyphs_box_or_relief (s); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_maybe_dumpglyphs_background (s, 1); + ns_dumpglyphs_box_or_relief (s); + ns_unfocus (s->f); box_drawn_p = 1; } @@ -4234,11 +4241,9 @@ ns_draw_glyph_string (struct glyph_string *s) case IMAGE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_dumpglyphs_image (s, r[0]); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_dumpglyphs_image (s, r[0]); + ns_unfocus (s->f); break; case STRETCH_GLYPH: @@ -4248,68 +4253,66 @@ ns_draw_glyph_string (struct glyph_string *s) case CHAR_GLYPH: case COMPOSITE_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); + ns_focus (s->f, r, n); - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); - { - BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; + } - if (isComposite) - ns_draw_composite_glyph_string_foreground (s); - else - ns_draw_glyph_string_foreground (s); - } + { + BOOL isComposite = s->first_glyph->type == COMPOSITE_GLYPH; - { - NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 - ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), - s->f) - : FRAME_FOREGROUND_COLOR (s->f)); - [col set]; - - /* Draw underline, overline, strike-through. */ - ns_draw_text_decoration (s, s->face, col, s->width, s->x); - } + if (isComposite) + ns_draw_composite_glyph_string_foreground (s); + else + ns_draw_glyph_string_foreground (s); + } - if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) - { - unsigned long tmp = NS_FACE_BACKGROUND (s->face); - NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); - NS_FACE_FOREGROUND (s->face) = tmp; - } + { + NSColor *col = (NS_FACE_FOREGROUND (s->face) != 0 + ? ns_lookup_indexed_color (NS_FACE_FOREGROUND (s->face), + s->f) + : FRAME_FOREGROUND_COLOR (s->f)); + [col set]; + + /* Draw underline, overline, strike-through. */ + ns_draw_text_decoration (s, s->face, col, s->width, s->x); + } - ns_reset_clipping (s->f); + if (s->hl == DRAW_CURSOR && s->w->phys_cursor_type == FILLED_BOX_CURSOR) + { + unsigned long tmp = NS_FACE_BACKGROUND (s->face); + NS_FACE_BACKGROUND (s->face) = NS_FACE_FOREGROUND (s->face); + NS_FACE_FOREGROUND (s->face) = tmp; } + + ns_unfocus (s->f); break; case GLYPHLESS_GLYPH: n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - if (s->for_overlaps || (s->cmp_from > 0 - && ! s->first_glyph->u.cmp.automatic)) - s->background_filled_p = 1; - else - ns_maybe_dumpglyphs_background - (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + + if (s->for_overlaps || (s->cmp_from > 0 + && ! s->first_glyph->u.cmp.automatic)) + s->background_filled_p = 1; + else + ns_maybe_dumpglyphs_background + (s, s->first_glyph->type == COMPOSITE_GLYPH); + /* ... */ + /* Not yet implemented. */ + /* ... */ + ns_unfocus (s->f); break; default: @@ -4320,11 +4323,9 @@ ns_draw_glyph_string (struct glyph_string *s) if (!s->for_overlaps && !box_drawn_p && s->face->box != FACE_NO_BOX) { n = ns_get_glyph_string_clip_rect (s, r); - if (ns_clip_to_rect (s->f, r, n)) - { - ns_dumpglyphs_box_or_relief (s); - ns_reset_clipping (s->f); - } + ns_focus (s->f, r, n); + ns_dumpglyphs_box_or_relief (s); + ns_unfocus (s->f); } s->num_clips = 0; @@ -6583,13 +6584,18 @@ not_in_argv (NSString *arg) { NSRect rect; NSPoint pt; - struct window *win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); + struct window *win; NSTRACE ("[EmacsView firstRectForCharacterRange:]"); if (NS_KEYLOG) NSLog (@"firstRectForCharRange request"); + if (WINDOWP (echo_area_window) && ! NILP (call0 (intern ("ns-in-echo-area")))) + win = XWINDOW (echo_area_window); + else + win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); + rect.size.width = theRange.length * FRAME_COLUMN_WIDTH (emacsframe); rect.size.height = FRAME_LINE_HEIGHT (emacsframe); pt.x = WINDOW_TEXT_TO_FRAME_PIXEL_X (win, win->phys_cursor.x); @@ -6696,8 +6702,6 @@ not_in_argv (NSString *arg) NSTRACE ("[EmacsView mouseDown:]"); - [self deleteWorkingText]; - if (!emacs_event) return; @@ -7087,6 +7091,7 @@ not_in_argv (NSString *arg) from non-native fullscreen, in other circumstances it appears to be a noop. (bug#28872) */ wr = NSMakeRect (0, 0, neww, newh); + [self createDrawingBuffer]; [view setFrame: wr]; // To do: consider using [NSNotificationCenter postNotificationName:]. @@ -7169,6 +7174,7 @@ not_in_argv (NSString *arg) size_title = xmalloc (strlen (old_title) + 40); esprintf (size_title, "%s — (%d x %d)", old_title, cols, rows); [window setTitle: [NSString stringWithUTF8String: size_title]]; + [window display]; xfree (size_title); } } @@ -7322,7 +7328,6 @@ not_in_argv (NSString *arg) if (emacs_event && is_focus_frame) { - [self deleteWorkingText]; emacs_event->kind = FOCUS_OUT_EVENT; EV_TRAILER ((id)nil); } @@ -7425,6 +7430,8 @@ not_in_argv (NSString *arg) maximizing_resize = NO; #endif + [self createDrawingBuffer]; + win = [[EmacsWindow alloc] initWithContentRect: r styleMask: (FRAME_UNDECORATED (f) @@ -7466,16 +7473,8 @@ not_in_argv (NSString *arg) if (! FRAME_UNDECORATED (f)) [self createToolbar: f]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 -#ifndef NSAppKitVersionNumber10_10 -#define NSAppKitVersionNumber10_10 1343 -#endif - if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10 - && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua) - win.appearance = [NSAppearance - appearanceNamed: NSAppearanceNameVibrantDark]; -#endif + [win setAppearance]; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 if ([win respondsToSelector: @selector(titlebarAppearsTransparent)]) @@ -8216,55 +8215,146 @@ not_in_argv (NSString *arg) } -- (void)viewWillDraw +#ifdef NS_IMPL_COCOA +- (void)createDrawingBuffer + /* Create and store a new CGGraphicsContext for Emacs to draw into. + + We can't do this in GNUstep as there's no equivalent, so under + GNUstep we retain the old method of drawing direct to the + EmacsView. */ { - /* If the frame has been garbaged there's no point in redrawing - anything. */ - if (FRAME_GARBAGED_P (emacsframe)) - [self setNeedsDisplay:NO]; + NSTRACE ("EmacsView createDrawingBuffer]"); + + NSGraphicsContext *screen; + CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace]; + CGFloat scale = [[self window] backingScaleFactor]; + NSRect frame = [self frame]; + + if (drawingBuffer != nil) + CGContextRelease (drawingBuffer); + + drawingBuffer = CGBitmapContextCreate (nil, NSWidth (frame) * scale, NSHeight (frame) * scale, + 8, 0, colorSpace, + kCGImageAlphaPremultipliedFirst | kCGBitmapByteOrder32Host); + + /* This fixes the scale to match the backing scale factor, and flips the image. */ + CGContextTranslateCTM(drawingBuffer, 0, NSHeight (frame) * scale); + CGContextScaleCTM(drawingBuffer, scale, -scale); } -- (void)drawRect: (NSRect)rect + +- (void)focusOnDrawingBuffer { - const NSRect *rectList; - NSInteger numRects; + NSTRACE ("EmacsView focusOnDrawingBuffer]"); - NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", - NSTRACE_ARG_RECT(rect)); + NSGraphicsContext *buf = + [NSGraphicsContext + graphicsContextWithCGContext:drawingBuffer flipped:YES]; - if (!emacsframe || !emacsframe->output_data.ns) - return; + [NSGraphicsContext setCurrentContext:buf]; +} - block_input (); - /* Get only the precise dirty rectangles to avoid redrawing - potentially large areas of the frame that haven't changed. +- (void)windowDidChangeBackingProperties:(NSNotification *)notification + /* Update the drawing buffer when the backing scale factor changes. */ +{ + NSTRACE ("EmacsView windowDidChangeBackingProperties:]"); + + CGFloat old = [[[notification userInfo] + objectForKey:@"NSBackingPropertyOldScaleFactorKey"] + doubleValue]; + CGFloat new = [[self window] backingScaleFactor]; - I'm not sure this actually provides much of a performance benefit - as it's hard to benchmark, but it certainly doesn't seem to - hurt. */ - [self getRectsBeingDrawn:&rectList count:&numRects]; - for (int i = 0 ; i < numRects ; i++) + if (old != new) { - NSRect r = rectList[i]; + NSRect frame = [self frame]; + [self createDrawingBuffer]; + ns_clear_frame (emacsframe); + expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame)); + } +} +#endif /* NS_IMPL_COCOA */ - NSTRACE_RECT ("r", r); - expose_frame (emacsframe, - NSMinX (r), NSMinY (r), - NSWidth (r), NSHeight (r)); - } +- (void)copyRect:(NSRect)srcRect to:(NSRect)dstRect +{ + NSTRACE ("[EmacsView copyRect:To:]"); + NSTRACE_RECT ("Source", srcRect); + NSTRACE_RECT ("Destination", dstRect); - unblock_input (); +#ifdef NS_IMPL_COCOA + CGImageRef copy; + NSRect frame = [self frame]; + NSAffineTransform *setOrigin = [NSAffineTransform transform]; + + [[NSGraphicsContext currentContext] saveGraphicsState]; + + /* Set the clipping before messing with the buffer's + orientation. */ + NSRectClip (dstRect); + + /* Unflip the buffer as the copied image will be unflipped, and + offset the top left so when we draw back into the buffer the + correct part of the image is drawn. */ + CGContextScaleCTM(drawingBuffer, 1, -1); + CGContextTranslateCTM(drawingBuffer, + NSMinX (dstRect) - NSMinX (srcRect), + -NSHeight (frame) - (NSMinY (dstRect) - NSMinY (srcRect))); + + /* Take a copy of the buffer and then draw it back to the buffer, + limited by the clipping rectangle. */ + copy = CGBitmapContextCreateImage (drawingBuffer); + CGContextDrawImage (drawingBuffer, frame, copy); + + CGImageRelease (copy); + + [[NSGraphicsContext currentContext] restoreGraphicsState]; + [self setNeedsDisplayInRect:dstRect]; +#else + hide_bell(); // Ensure the bell image isn't scrolled. + + ns_focus (emacsframe, &dstRect, 1); + [self scrollRect: srcRect + by: NSMakeSize (dstRect.origin.x - srcRect.origin.x, + dstRect.origin.y - srcRect.origin.y)]; + ns_unfocus (emacsframe); +#endif +} - /* - drawRect: may be called (at least in Mac OS X 10.5) for invisible - views as well for some reason. Thus, do not infer visibility - here. - emacsframe->async_visible = 1; - emacsframe->async_iconified = 0; - */ +#ifdef NS_IMPL_COCOA +- (BOOL)wantsUpdateLayer +{ + return YES; +} + + +- (void)updateLayer +{ + NSTRACE ("[EmacsView updateLayer]"); + + CGImageRef contentsImage = CGBitmapContextCreateImage(drawingBuffer); + [[self layer] setContents:(id)contentsImage]; + CGImageRelease(contentsImage); +} +#endif + + +- (void)drawRect: (NSRect)rect +{ + NSTRACE ("[EmacsView drawRect:" NSTRACE_FMT_RECT "]", + NSTRACE_ARG_RECT(rect)); + + if (!emacsframe || !emacsframe->output_data.ns) + return; + + int x = NSMinX (rect), y = NSMinY (rect); + int width = NSWidth (rect), height = NSHeight (rect); + + ns_clear_frame_area (emacsframe, x, y, width, height); + block_input (); + expose_frame (emacsframe, x, y, width, height); + unblock_input (); } @@ -8725,6 +8815,32 @@ not_in_argv (NSString *arg) #endif } +- (void)setAppearance +{ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 + struct frame *f = ((EmacsView *)[self delegate])->emacsframe; + NSAppearance *appearance = nil; + + NSTRACE ("[EmacsWindow setAppearance]"); + +#ifndef NSAppKitVersionNumber10_10 +#define NSAppKitVersionNumber10_10 1343 +#endif + + if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10) + return; + + if (FRAME_NS_APPEARANCE (f) == ns_appearance_vibrant_dark) + appearance = + [NSAppearance appearanceNamed:NSAppearanceNameVibrantDark]; + else if (FRAME_NS_APPEARANCE (f) == ns_appearance_aqua) + appearance = + [NSAppearance appearanceNamed:NSAppearanceNameAqua]; + + [self setAppearance:appearance]; +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ +} + - (void)setFrame:(NSRect)windowFrame display:(BOOL)displayViews { diff --git a/src/pdumper.c b/src/pdumper.c index 3ee11460405..0039f1a9ed8 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2961,7 +2961,7 @@ dump_vectorlike (struct dump_context *ctx, Lisp_Object lv, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_pvec_type_E55BD36F8E +#if CHECK_STRUCTS && !defined HASH_pvec_type_A4A6E9984D # error "pvec_type changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Vector *v = XVECTOR (lv); diff --git a/src/print.c b/src/print.c index 425b0dc4ee3..634169dbdbd 100644 --- a/src/print.c +++ b/src/print.c @@ -1365,6 +1365,22 @@ data_from_funcptr (void (*funcptr) (void)) interchangeably, so it's OK to assume that here too. */ return (void const *) funcptr; } + +/* Print the value of the pointer PTR. */ + +static void +print_pointer (Lisp_Object printcharfun, char *buf, const char *prefix, + const void *ptr) +{ + uintptr_t ui = (uintptr_t) ptr; + + /* In theory this assignment could lose info on pre-C99 hosts, but + in practice it doesn't. */ + uintmax_t up = ui; + + int len = sprintf (buf, "%s 0x%" PRIxMAX, prefix, up); + strout (buf, len, len, printcharfun); +} #endif static bool @@ -1796,26 +1812,22 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, case PVEC_MODULE_FUNCTION: { print_c_string ("#<module function ", printcharfun); - module_funcptr ptr = module_function_address (XMODULE_FUNCTION (obj)); + const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj); + module_funcptr ptr = module_function_address (function); char const *file; char const *symbol; dynlib_addr (ptr, &file, &symbol); if (symbol == NULL) - { - uintptr_t ui = (uintptr_t) data_from_funcptr (ptr); - - /* In theory this assignment could lose info on pre-C99 - hosts, but in practice it doesn't. */ - uintmax_t up = ui; - - int len = sprintf (buf, "at 0x%"PRIxMAX, up); - strout (buf, len, len, printcharfun); - } - else + print_pointer (printcharfun, buf, "at", data_from_funcptr (ptr)); + else print_c_string (symbol, printcharfun); - if (file != NULL) + void *data = module_function_data (function); + if (data != NULL) + print_pointer (printcharfun, buf, " with data", data); + + if (file != NULL) { print_c_string (" from ", printcharfun); print_c_string (file, printcharfun); @@ -1838,7 +1850,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) { char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), max (sizeof " . #" + INT_STRLEN_BOUND (intmax_t), - max ((sizeof "at 0x" + max ((sizeof " with data 0x" + (sizeof (uintmax_t) * CHAR_BIT + 4 - 1) / 4), 40)))]; current_thread->stack_top = buf; diff --git a/src/sysdep.c b/src/sysdep.c index cb2f7f2f23c..e8e8bbfb502 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -135,11 +135,6 @@ int _cdecl _spawnlp (int, const char *, const char *, ...); # include <sys/socket.h> #endif -/* ULLONG_MAX is missing on Red Hat Linux 7.3; see Bug#11781. */ -#ifndef ULLONG_MAX -#define ULLONG_MAX TYPE_MAXIMUM (unsigned long long int) -#endif - /* Declare here, including term.h is problematic on some systems. */ extern void tputs (const char *, int, int (*)(int)); @@ -317,8 +312,8 @@ get_current_dir_name_or_unreachable (void) if (pwd && (pwdlen = strnlen (pwd, bufsize_max)) < bufsize_max && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0]) - && stat (pwd, &pwdstat) == 0 - && stat (".", &dotstat) == 0 + && emacs_fstatat (AT_FDCWD, pwd, &pwdstat, 0) == 0 + && emacs_fstatat (AT_FDCWD, ".", &dotstat, 0) == 0 && dotstat.st_ino == pwdstat.st_ino && dotstat.st_dev == pwdstat.st_dev) { @@ -2454,7 +2449,27 @@ emacs_abort (void) } #endif -/* Open FILE for Emacs use, using open flags OFLAG and mode MODE. +/* Assuming the directory DIRFD, store information about FILENAME into *ST, + using FLAGS to control how the status is obtained. + Do not fail merely because fetching info was interrupted by a signal. + Allow the user to quit. + + The type of ST is void * instead of struct stat * because the + latter type would be problematic in lisp.h. Some platforms may + play tricks like "#define stat stat64" in <sys/stat.h>, and lisp.h + does not include <sys/stat.h>. */ + +int +emacs_fstatat (int dirfd, char const *filename, void *st, int flags) +{ + int r; + while ((r = fstatat (dirfd, filename, st, flags)) != 0 && errno == EINTR) + maybe_quit (); + return r; +} + +/* Assuming the directory DIRFD, open FILE for Emacs use, + using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. Arrange for subprograms to not inherit the file descriptor. Prefer a method that is multithread-safe, if available. @@ -2462,17 +2477,23 @@ emacs_abort (void) Allow the user to quit. */ int -emacs_open (const char *file, int oflags, int mode) +emacs_openat (int dirfd, char const *file, int oflags, int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } +int +emacs_open (char const *file, int oflags, int mode) +{ + return emacs_openat (AT_FDCWD, file, oflags, mode); +} + /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ @@ -3141,7 +3162,7 @@ make_lisp_timeval (struct timeval t) #endif -#if defined GNU_LINUX && defined HAVE_LONG_LONG_INT +#ifdef GNU_LINUX static struct timespec time_from_jiffies (unsigned long long tval, long hz) { diff --git a/src/thread.c b/src/thread.c index c7fe0614269..df1a7053826 100644 --- a/src/thread.c +++ b/src/thread.c @@ -1114,9 +1114,6 @@ syms_of_threads (void) staticpro (&last_thread_error); last_thread_error = Qnil; - Fdefalias (intern_c_string ("thread-alive-p"), - intern_c_string ("thread-live-p"), Qnil); - Fprovide (intern_c_string ("threads"), Qnil); } diff --git a/src/w32.c b/src/w32.c index 62c53fd7711..a3b9a5683ad 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4592,6 +4592,27 @@ sys_open (const char * path, int oflag, int mode) } int +openat (int fd, const char * path, int oflag, int mode) +{ + /* Rely on a hack: an open directory is modeled as file descriptor 0, + as in fstatat. FIXME: Add proper support for openat. */ + char fullname[MAX_UTF8_PATH]; + + if (fd != AT_FDCWD) + { + if (_snprintf (fullname, sizeof fullname, "%s/%s", dir_pathname, path) + < 0) + { + errno = ENAMETOOLONG; + return -1; + } + path = fullname; + } + + return sys_open (path, oflag, mode); +} + +int fchmod (int fd, mode_t mode) { return 0; diff --git a/src/w32.h b/src/w32.h index b8655ec788c..f301b3836ca 100644 --- a/src/w32.h +++ b/src/w32.h @@ -221,6 +221,7 @@ extern void register_child (pid_t, int); extern void sys_sleep (int); extern int sys_link (const char *, const char *); +extern int openat (int, const char *, int, int); /* Return total and free memory info. */ extern int w32_memory_info (unsigned long long *, unsigned long long *, diff --git a/src/w32heap.c b/src/w32heap.c index 3a6c7804675..ececc73c026 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -597,6 +597,16 @@ free_after_dump_9x (void *ptr) } } +void * +sys_calloc (size_t number, size_t size) +{ + size_t nbytes = number * size; + void *ptr = (*the_malloc_fn) (nbytes); + if (ptr) + memset (ptr, 0, nbytes); + return ptr; +} + #if defined HAVE_UNEXEC && defined ENABLE_CHECKING void report_temacs_memory_usage (void) diff --git a/src/window.c b/src/window.c index ff17cd88f38..8cdad27b664 100644 --- a/src/window.c +++ b/src/window.c @@ -7976,19 +7976,17 @@ foreach_window_1 (struct window *w, bool (*fn) (struct window *, void *), /* Return true if window configurations CONFIGURATION1 and CONFIGURATION2 describe the same state of affairs. This is used by Fequal. - IGNORE_POSITIONS means ignore non-matching scroll positions - and the like. + Ignore non-matching scroll positions and the like. This ignores a couple of things like the dedication status of window, combination_limit and the like. This might have to be fixed. */ -bool +static bool compare_window_configurations (Lisp_Object configuration1, - Lisp_Object configuration2, - bool ignore_positions) + Lisp_Object configuration2) { - register struct save_window_data *d1, *d2; + struct save_window_data *d1, *d2; struct Lisp_Vector *sws1, *sws2; ptrdiff_t i; @@ -8006,9 +8004,6 @@ compare_window_configurations (Lisp_Object configuration1, || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines || !EQ (d1->selected_frame, d2->selected_frame) || !EQ (d1->f_current_buffer, d2->f_current_buffer) - || (!ignore_positions - && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window) - || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window))) || !EQ (d1->focus_frame, d2->focus_frame) /* Verify that the two configurations have the same number of windows. */ || sws1->header.size != sws2->header.size) @@ -8041,12 +8036,6 @@ compare_window_configurations (Lisp_Object configuration1, equality. */ || !EQ (sw1->parent, sw2->parent) || !EQ (sw1->prev, sw2->prev) - || (!ignore_positions - && (!EQ (sw1->hscroll, sw2->hscroll) - || !EQ (sw1->min_hscroll, sw2->min_hscroll) - || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg) - || NILP (Fequal (sw1->start, sw2->start)) - || NILP (Fequal (sw1->pointm, sw2->pointm)))) || !EQ (sw1->left_margin_cols, sw2->left_margin_cols) || !EQ (sw1->right_margin_cols, sw2->right_margin_cols) || !EQ (sw1->left_fringe_width, sw2->left_fringe_width) @@ -8071,7 +8060,7 @@ This function ignores details such as the values of point and scrolling positions. */) (Lisp_Object x, Lisp_Object y) { - if (compare_window_configurations (x, y, true)) + if (compare_window_configurations (x, y)) return Qt; return Qnil; } diff --git a/src/window.h b/src/window.h index aa8d2c8d1d2..167d1be7abb 100644 --- a/src/window.h +++ b/src/window.h @@ -1184,7 +1184,6 @@ extern Lisp_Object window_list (void); extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter); extern struct window *decode_live_window (Lisp_Object); extern struct window *decode_any_window (Lisp_Object); -extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool); extern void mark_window_cursors_off (struct window *); extern bool window_wants_mode_line (struct window *); extern bool window_wants_header_line (struct window *); diff --git a/src/xdisp.c b/src/xdisp.c index 3a8b5e3f1d0..e41ceaf0bb7 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8573,7 +8573,7 @@ compute_stop_pos_backwards (struct it *it) position before that. This is called when we bump into a stop position while reordering bidirectional text. CHARPOS should be the last previously processed stop_pos (or BEGV/0, if none were - processed yet) whose position is less that IT's current + processed yet) whose position is less than IT's current position. */ static void @@ -30741,14 +30741,6 @@ get_specified_cursor_type (Lisp_Object arg, int *width) return BAR_CURSOR; } - if (CONSP (arg) - && EQ (XCAR (arg), Qbar) - && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) - { - *width = XFIXNUM (XCDR (arg)); - return BAR_CURSOR; - } - if (EQ (arg, Qhbar)) { *width = 2; @@ -30756,11 +30748,16 @@ get_specified_cursor_type (Lisp_Object arg, int *width) } if (CONSP (arg) - && EQ (XCAR (arg), Qhbar) && RANGED_FIXNUMP (0, XCDR (arg), INT_MAX)) { *width = XFIXNUM (XCDR (arg)); - return HBAR_CURSOR; + + if (EQ (XCAR (arg), Qbox)) + return FILLED_BOX_CURSOR; + else if (EQ (XCAR (arg), Qbar)) + return BAR_CURSOR; + else if (EQ (XCAR (arg), Qhbar)) + return HBAR_CURSOR; } /* Treat anything unknown as "hollow box cursor". @@ -30887,23 +30884,28 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, if (!w->cursor_off_p) { if (glyph != NULL && glyph->type == XWIDGET_GLYPH) - return NO_CURSOR; + return NO_CURSOR; if (glyph != NULL && glyph->type == IMAGE_GLYPH) { if (cursor_type == FILLED_BOX_CURSOR) { - /* Using a block cursor on large images can be very annoying. - So use a hollow cursor for "large" images. - If image is not transparent (no mask), also use hollow cursor. */ + /* Using a block cursor on large images can be very + annoying. So use a hollow cursor for "large" images. + If image is not transparent (no mask), also use + hollow cursor. */ struct image *img = IMAGE_OPT_FROM_ID (f, glyph->u.img_id); if (img != NULL && IMAGEP (img->spec)) { - /* Arbitrarily, interpret "Large" as >32x32 and >NxN - where N = size of default frame font size. - This should cover most of the "tiny" icons people may use. */ + /* Interpret "large" as >SIZExSIZE and >NxN where + SIZE is the value from cursor-type of the form + (box . SIZE), where N = size of default frame + font size. So, setting cursor-type to (box . 32) + should cover most of the "tiny" icons people may + use. */ if (!img->mask - || img->width > max (32, WINDOW_FRAME_COLUMN_WIDTH (w)) - || img->height > max (32, WINDOW_FRAME_LINE_HEIGHT (w))) + || (CONSP (BVAR (b, cursor_type)) + && img->width > max (*width, WINDOW_FRAME_COLUMN_WIDTH (w)) + && img->height > max (*width, WINDOW_FRAME_LINE_HEIGHT (w)))) cursor_type = HOLLOW_BOX_CURSOR; } } diff --git a/src/xfns.c b/src/xfns.c index 276ea1c3935..5758bb7a18c 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3878,8 +3878,6 @@ This function is an internal primitive--use `make-frame' instead. */) #ifdef HAVE_HARFBUZZ register_font_driver (&xfthbfont_driver, f); #endif -#else /* not HAVE_XFT */ - register_font_driver (&ftxfont_driver, f); #endif /* not HAVE_XFT */ #endif /* HAVE_FREETYPE */ #endif /* not USE_CAIRO */ @@ -6364,8 +6362,6 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms) #ifdef HAVE_HARFBUZZ register_font_driver (&xfthbfont_driver, f); #endif -#else /* not HAVE_XFT */ - register_font_driver (&ftxfont_driver, f); #endif /* not HAVE_XFT */ #endif /* HAVE_FREETYPE */ #endif /* not USE_CAIRO */ diff --git a/src/xrdb.c b/src/xrdb.c index ad7155c106e..e3a1fcb15a9 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -353,7 +353,7 @@ get_environ_db (void) p = filename = xmalloc (strlen (home) + 1 + sizeof xdefaults + 1 + SBYTES (system_name)); char *e = splice_dir_file (p, home, xdefaults); - *e++ = '/'; + *e++ = '-'; lispstpcpy (e, system_name); } } diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 8dc9ff144af..ec6948921f2 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <errno.h> #include <limits.h> +#include <stdint.h> #include <stdio.h> #include <stdlib.h> #include <string.h> @@ -86,6 +87,7 @@ static emacs_value Fmod_test_sum (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) { assert (nargs == 2); + assert ((uintptr_t) data == 0x1234); intmax_t a = env->extract_integer (env, args[0]); intmax_t b = env->extract_integer (env, args[1]); @@ -373,15 +375,20 @@ Fmod_test_add_nanosecond (emacs_env *env, ptrdiff_t nargs, emacs_value *args, } static void -memory_full (emacs_env *env) +signal_error (emacs_env *env, const char *message) { - const char *message = "Memory exhausted"; emacs_value data = env->make_string (env, message, strlen (message)); env->non_local_exit_signal (env, env->intern (env, "error"), env->funcall (env, env->intern (env, "list"), 1, &data)); } +static void +memory_full (emacs_env *env) +{ + signal_error (env, "Memory exhausted"); +} + enum { max_count = ((SIZE_MAX < PTRDIFF_MAX ? SIZE_MAX : PTRDIFF_MAX) @@ -490,6 +497,42 @@ Fmod_test_double (emacs_env *env, ptrdiff_t nargs, emacs_value *args, return result; } +static int function_data; +static int finalizer_calls_with_correct_data; +static int finalizer_calls_with_incorrect_data; + +static void +finalizer (void *data) +{ + if (data == &function_data) + ++finalizer_calls_with_correct_data; + else + ++finalizer_calls_with_incorrect_data; +} + +static emacs_value +Fmod_test_make_function_with_finalizer (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value fun + = env->make_function (env, 2, 2, Fmod_test_sum, NULL, &function_data); + env->set_function_finalizer (env, fun, finalizer); + if (env->get_function_finalizer (env, fun) != finalizer) + signal_error (env, "Invalid finalizer"); + return fun; +} + +static emacs_value +Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, void *data) +{ + emacs_value Flist = env->intern (env, "list"); + emacs_value list_args[] + = {env->make_integer (env, finalizer_calls_with_correct_data), + env->make_integer (env, finalizer_calls_with_incorrect_data)}; + return env->funcall (env, Flist, 2, list_args); +} + /* Lisp utilities for easier readability (simple wrappers). */ /* Provide FEATURE to Emacs. */ @@ -546,7 +589,8 @@ emacs_module_init (struct emacs_runtime *ert) env->make_function (env, amin, amax, csym, doc, data)) DEFUN ("mod-test-return-t", Fmod_test_return_t, 1, 1, NULL, NULL); - DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)", NULL); + DEFUN ("mod-test-sum", Fmod_test_sum, 2, 2, "Return A + B\n\n(fn a b)", + (void *) (uintptr_t) 0x1234); DEFUN ("mod-test-signal", Fmod_test_signal, 0, 0, NULL, NULL); DEFUN ("mod-test-throw", Fmod_test_throw, 0, 0, NULL, NULL); DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall, @@ -566,6 +610,10 @@ emacs_module_init (struct emacs_runtime *ert) DEFUN ("mod-test-add-nanosecond", Fmod_test_add_nanosecond, 1, 1, NULL, NULL); DEFUN ("mod-test-nanoseconds", Fmod_test_nanoseconds, 1, 1, NULL, NULL); DEFUN ("mod-test-double", Fmod_test_double, 1, 1, NULL, NULL); + DEFUN ("mod-test-make-function-with-finalizer", + Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL); + DEFUN ("mod-test-function-finalizer-calls", + Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL); #undef DEFUN diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 10ed9c39fbb..677abb33cc9 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -353,6 +353,10 @@ HOSTNAME, USER and PORT are passed unchanged to (auth-source-pass--with-store '(("bar.com:8080")) (should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil "8080")))) +(ert-deftest auth-source-pass--matching-entries-find-entries-with-a-port-when-passed-multiple-ports () + (auth-source-pass--with-store '(("bar.com:8080")) + (should (auth-source-pass-match-entry-p "bar.com:8080" "bar.com" nil '("http" "https" "80" "8080"))))) + (ert-deftest auth-source-pass--matching-entries-find-entries-with-slash () ;; match if entry filename matches user (auth-source-pass--with-store '(("foo.com/user")) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index f7c5580b111..ec3e4bb77ba 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -59,8 +59,7 @@ auto-revert-notify-exclude-dir-regexp "nothing-to-be-excluded" auto-revert-stop-on-user-input nil file-notify-debug nil - tramp-verbose 0 - tramp-message-show-message nil) + tramp-verbose 0) (defconst auto-revert--timeout (1+ auto-revert-interval) "Time to wait for a message.") diff --git a/test/lisp/bookmark-tests.el b/test/lisp/bookmark-tests.el index 7e0384b7241..b9c6ff9c542 100644 --- a/test/lisp/bookmark-tests.el +++ b/test/lisp/bookmark-tests.el @@ -25,6 +25,7 @@ (require 'ert) (require 'bookmark) +(require 'cl-lib) (defvar bookmark-tests-data-dir (file-truename @@ -339,21 +340,21 @@ testing `bookmark-bmenu-list'." ,@body) (kill-buffer bookmark-bmenu-buffer))))) -(ert-deftest bookmark-bmenu.enu-edit-annotation/show-annotation () +(ert-deftest bookmark-test-bmenu-edit-annotation/show-annotation () (with-bookmark-bmenu-test (bookmark-set-annotation "name" "foo") (bookmark-bmenu-edit-annotation) (should (string-match "foo" (buffer-string))) (kill-buffer (current-buffer)))) -(ert-deftest bookmark-bmenu-send-edited-annotation () +(ert-deftest bookmark-test-bmenu-send-edited-annotation () (with-bookmark-bmenu-test (bookmark-bmenu-edit-annotation) (insert "foo") (bookmark-send-edited-annotation) (should (equal (bookmark-get-annotation "name") "foo")))) -(ert-deftest bookmark-bmenu-send-edited-annotation/restore-focus () +(ert-deftest bookmark-test-bmenu-send-edited-annotation/restore-focus () "Test for https://debbugs.gnu.org/20150 ." (with-bookmark-bmenu-test (bookmark-bmenu-edit-annotation) @@ -362,5 +363,73 @@ testing `bookmark-bmenu-list'." (should (equal (buffer-name (current-buffer)) bookmark-bmenu-buffer)) (should (looking-at "name")))) +(ert-deftest bookmark-test-bmenu-toggle-filenames () + (with-bookmark-bmenu-test + (should (re-search-forward "/some/file" nil t)) + (bookmark-bmenu-toggle-filenames) + (goto-char (point-min)) + (should-not (re-search-forward "/some/file" nil t)))) + +(ert-deftest bookmark-test-bmenu-toggle-filenames/show () + (with-bookmark-bmenu-test + (bookmark-bmenu-toggle-filenames t) + (should (re-search-forward "/some/file")))) + +(ert-deftest bookmark-test-bmenu-show-filenames () + (with-bookmark-bmenu-test + (bookmark-bmenu-show-filenames) + (should (re-search-forward "/some/file")))) + +(ert-deftest bookmark-test-bmenu-hide-filenames () + (with-bookmark-bmenu-test + (bookmark-bmenu-hide-filenames) + (goto-char (point-min)) + (should-not (re-search-forward "/some/file" nil t)))) + +(ert-deftest bookmark-test-bmenu-bookmark () + (with-bookmark-bmenu-test + (should (equal (bookmark-bmenu-bookmark) "name")))) + +(ert-deftest bookmark-test-bmenu-mark () + (with-bookmark-bmenu-test + (bookmark-bmenu-mark) + (beginning-of-line) + (should (looking-at "^>")))) + +(ert-deftest bookmark-test-bmenu-any-marks () + (with-bookmark-bmenu-test + (bookmark-bmenu-mark) + (beginning-of-line) + (should (bookmark-bmenu-any-marks)))) + +(ert-deftest bookmark-test-bmenu-unmark () + (with-bookmark-bmenu-test + (bookmark-bmenu-mark) + (goto-char (point-min)) + (bookmark-bmenu-unmark) + (beginning-of-line) + (should (looking-at "^ ")))) + +(ert-deftest bookmark-test-bmenu-delete () + (with-bookmark-bmenu-test + (bookmark-bmenu-delete) + (bookmark-bmenu-execute-deletions) + (should (equal (length bookmark-alist) 0)))) + +(ert-deftest bookmark-test-bmenu-locate () + (let (msg) + (cl-letf (((symbol-function 'message) + (lambda (&rest args) + (setq msg (apply #'format args))))) + (with-bookmark-bmenu-test + (bookmark-bmenu-locate) + (should (equal msg "/some/file")))))) + +(ert-deftest bookmark-test-bmenu-filter-alist-by-regexp () + (with-bookmark-bmenu-test + (bookmark-bmenu-filter-alist-by-regexp regexp-unmatchable) + (goto-char (point-min)) + (should (looking-at "^$")))) + (provide 'bookmark-tests) ;;; bookmark-tests.el ends here diff --git a/test/lisp/calendar/iso8601-tests.el b/test/lisp/calendar/iso8601-tests.el index 430680c5077..e8b155a7aa7 100644 --- a/test/lisp/calendar/iso8601-tests.el +++ b/test/lisp/calendar/iso8601-tests.el @@ -24,49 +24,61 @@ (ert-deftest test-iso8601-date-years () (should (equal (iso8601-parse-date "1985") - '(nil nil nil nil nil 1985 nil nil nil))) + '(nil nil nil nil nil 1985 nil -1 nil))) (should (equal (iso8601-parse-date "-0003") - '(nil nil nil nil nil -3 nil nil nil))) + '(nil nil nil nil nil -3 nil -1 nil))) (should (equal (iso8601-parse-date "+1985") - '(nil nil nil nil nil 1985 nil nil nil)))) + '(nil nil nil nil nil 1985 nil -1 nil)))) (ert-deftest test-iso8601-date-dates () (should (equal (iso8601-parse-date "1985-03-14") - '(nil nil nil 14 3 1985 nil nil nil))) + '(nil nil nil 14 3 1985 nil -1 nil))) (should (equal (iso8601-parse-date "19850314") - '(nil nil nil 14 3 1985 nil nil nil))) + '(nil nil nil 14 3 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-02") - '(nil nil nil nil 2 1985 nil nil nil)))) + '(nil nil nil nil 2 1985 nil -1 nil)))) (ert-deftest test-iso8601-date-obsolete () (should (equal (iso8601-parse-date "--02-01") - '(nil nil nil 1 2 nil nil nil nil))) + '(nil nil nil 1 2 nil nil -1 nil))) (should (equal (iso8601-parse-date "--0201") - '(nil nil nil 1 2 nil nil nil nil)))) + '(nil nil nil 1 2 nil nil -1 nil)))) + +(ert-deftest test-iso8601-date-obsolete-2000 () + ;; These are forms in 5.2.1.3 of the 2000 version of the standard, + ;; e) and f). + (should (equal (iso8601-parse-date "--12") + '(nil nil nil nil 12 nil nil -1 nil))) + (should (equal (iso8601-parse "--12T14") + '(0 0 14 nil 12 nil nil -1 nil))) + (should (equal (iso8601-parse-date "---12") + '(nil nil nil 12 nil nil nil -1 nil))) + (should (equal (iso8601-parse "---12T14:10:12") + '(12 10 14 12 nil nil nil -1 nil)))) (ert-deftest test-iso8601-date-weeks () (should (equal (iso8601-parse-date "2008W39-6") - '(nil nil nil 27 9 2008 nil nil nil))) + '(nil nil nil 27 9 2008 nil -1 nil))) (should (equal (iso8601-parse-date "2009W01-1") - '(nil nil nil 29 12 2008 nil nil nil))) + '(nil nil nil 29 12 2008 nil -1 nil))) (should (equal (iso8601-parse-date "2009W53-7") - '(nil nil nil 3 1 2010 nil nil nil)))) + '(nil nil nil 3 1 2010 nil -1 nil)))) (ert-deftest test-iso8601-date-ordinals () (should (equal (iso8601-parse-date "1981-095") - '(nil nil nil 5 4 1981 nil nil nil)))) + '(nil nil nil 5 4 1981 nil -1 nil)))) (ert-deftest test-iso8601-time () (should (equal (iso8601-parse-time "13:47:30") - '(30 47 13 nil nil nil nil nil nil))) + '(30 47 13 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "134730") - '(30 47 13 nil nil nil nil nil nil))) + '(30 47 13 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "1347") - '(0 47 13 nil nil nil nil nil nil)))) + '(0 47 13 nil nil nil nil -1 nil)))) (ert-deftest test-iso8601-combined () (should (equal (iso8601-parse "2008-03-02T13:47:30") - '(30 47 13 2 3 2008 nil nil nil))) + '(30 47 13 2 3 2008 nil -1 nil))) (should (equal (iso8601-parse "2008-03-02T13:47:30Z") '(30 47 13 2 3 2008 nil nil 0))) (should (equal (iso8601-parse "2008-03-02T13:47:30+01:00") @@ -76,13 +88,13 @@ (ert-deftest test-iso8601-duration () (should (equal (iso8601-parse-duration "P3Y6M4DT12H30M5S") - '(5 30 12 4 6 3 nil nil nil))) + '(5 30 12 4 6 3 nil -1 nil))) (should (equal (iso8601-parse-duration "P1M") - '(0 0 0 0 1 0 nil nil nil))) + '(0 0 0 0 1 0 nil -1 nil))) (should (equal (iso8601-parse-duration "PT1M") - '(0 1 0 0 0 0 nil nil nil))) + '(0 1 0 0 0 0 nil -1 nil))) (should (equal (iso8601-parse-duration "P0003-06-04T12:30:05") - '(5 30 12 4 6 3 nil nil nil)))) + '(5 30 12 4 6 3 nil -1 nil)))) (ert-deftest test-iso8601-invalid () (should-not (iso8601-valid-p " 2008-03-02T13:47:30-01")) @@ -101,88 +113,88 @@ (should (equal (iso8601-parse-interval "2007-03-01T13:00:00Z/P1Y2M10DT2H30M") '((0 0 13 1 3 2007 nil nil 0) (0 30 15 11 5 2008 nil nil 0) - (0 30 2 10 2 1 nil nil nil)))) + (0 30 2 10 2 1 nil -1 nil)))) (should (equal (iso8601-parse-interval "P1Y2M10DT2H30M/2008-05-11T15:30:00Z") '((0 0 13 1 3 2007 nil nil 0) (0 30 15 11 5 2008 nil nil 0) - (0 30 2 10 2 1 nil nil nil))))) + (0 30 2 10 2 1 nil -1 nil))))) (ert-deftest standard-test-dates () (should (equal (iso8601-parse-date "19850412") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-04-12") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985102") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-102") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985W155") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-W15-5") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985W15") - '(nil nil nil 7 4 1985 nil nil nil))) + '(nil nil nil 7 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-W15") - '(nil nil nil 7 4 1985 nil nil nil))) + '(nil nil nil 7 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985-04") - '(nil nil nil nil 4 1985 nil nil nil))) + '(nil nil nil nil 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "1985") - '(nil nil nil nil nil 1985 nil nil nil))) + '(nil nil nil nil nil 1985 nil -1 nil))) (should (equal (iso8601-parse-date "+1985-04-12") - '(nil nil nil 12 4 1985 nil nil nil))) + '(nil nil nil 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse-date "+19850412") - '(nil nil nil 12 4 1985 nil nil nil)))) + '(nil nil nil 12 4 1985 nil -1 nil)))) (ert-deftest standard-test-time-of-day-local-time () (should (equal (iso8601-parse-time "152746") - '(46 27 15 nil nil nil nil nil nil))) + '(46 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15:27:46") - '(46 27 15 nil nil nil nil nil nil))) + '(46 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "1528") - '(0 28 15 nil nil nil nil nil nil))) + '(0 28 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15:28") - '(0 28 15 nil nil nil nil nil nil))) + '(0 28 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15") - '(0 0 15 nil nil nil nil nil nil)))) + '(0 0 15 nil nil nil nil -1 nil)))) (ert-deftest standard-test-time-of-day-fractions () (should (equal (iso8601-parse-time "152735,5" t) - '((355 . 10) 27 15 nil nil nil nil nil nil))) + '((355 . 10) 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15:27:35,5" t) - '((355 . 10) 27 15 nil nil nil nil nil nil))) + '((355 . 10) 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "2320,5" t) - '(30 20 23 nil nil nil nil nil nil))) + '(30 20 23 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "23:20,8" t) - '(48 20 23 nil nil nil nil nil nil))) + '(48 20 23 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "23,3" t) - '(0 18 23 nil nil nil nil nil nil)))) + '(0 18 23 nil nil nil nil -1 nil)))) (ert-deftest nonstandard-test-time-of-day-decimals () (should (equal (iso8601-parse-time "15:27:35.123" t) - '((35123 . 1000) 27 15 nil nil nil nil nil nil))) + '((35123 . 1000) 27 15 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "15:27:35.123456789" t) - '((35123456789 . 1000000000) 27 15 nil nil nil nil nil nil)))) + '((35123456789 . 1000000000) 27 15 nil nil nil nil -1 nil)))) (ert-deftest standard-test-time-of-day-beginning-of-day () (should (equal (iso8601-parse-time "000000") - '(0 0 0 nil nil nil nil nil nil))) + '(0 0 0 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "00:00:00") - '(0 0 0 nil nil nil nil nil nil))) + '(0 0 0 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "0000") - '(0 0 0 nil nil nil nil nil nil))) + '(0 0 0 nil nil nil nil -1 nil))) (should (equal (iso8601-parse-time "00:00") - '(0 0 0 nil nil nil nil nil nil)))) + '(0 0 0 nil nil nil nil -1 nil)))) (ert-deftest standard-test-time-of-day-utc () (should (equal (iso8601-parse-time "232030Z") @@ -222,9 +234,9 @@ (ert-deftest standard-test-date-and-time-of-day () (should (equal (iso8601-parse "19850412T101530") - '(30 15 10 12 4 1985 nil nil nil))) + '(30 15 10 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse "1985-04-12T10:15:30") - '(30 15 10 12 4 1985 nil nil nil))) + '(30 15 10 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse "1985102T235030Z") '(30 50 23 12 4 1985 nil nil 0))) @@ -232,9 +244,9 @@ '(30 50 23 12 4 1985 nil nil 0))) (should (equal (iso8601-parse "1985W155T235030") - '(30 50 23 12 4 1985 nil nil nil))) + '(30 50 23 12 4 1985 nil -1 nil))) (should (equal (iso8601-parse "1985-W155T23:50:30") - '(30 50 23 12 4 1985 nil nil nil)))) + '(30 50 23 12 4 1985 nil -1 nil)))) (ert-deftest standard-test-interval () ;; A time interval starting at 20 minutes and 50 seconds past 23 @@ -256,48 +268,48 @@ ;; This example doesn't seem valid according to the standard. ;; "0625" is unambiguous, and means "the year 625". Weird. ;; (should (equal (iso8601-parse-interval "19850412/0625") - ;; '((nil nil nil 12 4 1985 nil nil nil) - ;; (nil nil nil nil nil 625 nil nil nil) + ;; '((nil nil nil 12 4 1985 nil -1 nil) + ;; (nil nil nil nil nil 625 nil -1 nil) ;; (0 17 0 22 9 609 5 nil 0)))) ;; A time interval of 2 years, 10 months, 15 days, 10 hours, 20 ;; minutes and 30 seconds. (should (equal (iso8601-parse-duration "P2Y10M15DT10H20M30S") - '(30 20 10 15 10 2 nil nil nil))) + '(30 20 10 15 10 2 nil -1 nil))) (should (equal (iso8601-parse-duration "P00021015T102030") - '(30 20 10 15 10 2 nil nil nil))) + '(30 20 10 15 10 2 nil -1 nil))) (should (equal (iso8601-parse-duration "P0002-10-15T10:20:30") - '(30 20 10 15 10 2 nil nil nil))) + '(30 20 10 15 10 2 nil -1 nil))) ;; A time interval of 1 year and 6 months. (should (equal (iso8601-parse-duration "P1Y6M") - '(0 0 0 0 6 1 nil nil nil))) + '(0 0 0 0 6 1 nil -1 nil))) (should (equal (iso8601-parse-duration "P0001-06") - '(nil nil nil nil 6 1 nil nil nil))) + '(nil nil nil nil 6 1 nil -1 nil))) ;; A time interval of seventy-two hours. (should (equal (iso8601-parse-duration "PT72H") - '(0 0 72 0 0 0 nil nil nil))) + '(0 0 72 0 0 0 nil -1 nil))) ;; Defined by start and duration ;; A time interval of 1 year, 2 months, 15 days and 12 hours, ;; beginning on 12 April 1985 at 20 minutes past 23 hours. (should (equal (iso8601-parse-interval "19850412T232000/P1Y2M15DT12H") - '((0 20 23 12 4 1985 nil nil nil) - (0 20 11 28 6 1986 nil nil nil) - (0 0 12 15 2 1 nil nil nil)))) + '((0 20 23 12 4 1985 nil -1 nil) + (0 20 11 28 6 1986 nil -1 nil) + (0 0 12 15 2 1 nil -1 nil)))) (should (equal (iso8601-parse-interval "1985-04-12T23:20:00/P1Y2M15DT12H") - '((0 20 23 12 4 1985 nil nil nil) - (0 20 11 28 6 1986 nil nil nil) - (0 0 12 15 2 1 nil nil nil)))) + '((0 20 23 12 4 1985 nil -1 nil) + (0 20 11 28 6 1986 nil -1 nil) + (0 0 12 15 2 1 nil -1 nil)))) ;; Defined by duration and end ;; A time interval of 1 year, 2 months, 15 days and 12 hours, ending ;; on 12 April 1985 at 20 minutes past 23 hour. (should (equal (iso8601-parse-interval "P1Y2M15DT12H/19850412T232000") - '((0 20 11 28 1 1984 nil nil nil) - (0 20 23 12 4 1985 nil nil nil) - (0 0 12 15 2 1 nil nil nil))))) + '((0 20 11 28 1 1984 nil -1 nil) + (0 20 23 12 4 1985 nil -1 nil) + (0 0 12 15 2 1 nil -1 nil))))) ;;; iso8601-tests.el ends here diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index a16adfedfb8..de11ae22d50 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -615,17 +615,6 @@ literals (Bug#20852)." (let ((byte-compile-dest-file-function (lambda (_) destination))) (should (byte-compile-file source))))))) -(ert-deftest bytecomp-tests--old-style-backquotes () - "Check that byte compiling warns about old-style backquotes." - (bytecomp-tests--with-temp-file source - (write-region "(` (a b))" nil source) - (bytecomp-tests--with-temp-file destination - (let* ((byte-compile-dest-file-function (lambda (_) destination)) - (byte-compile-debug t) - (err (should-error (byte-compile-file source)))) - (should (equal (cdr err) '("Old-style backquotes detected!"))))))) - - (ert-deftest bytecomp-tests-function-put () "Check `function-put' operates during compilation." (bytecomp-tests--with-temp-file source diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index c52bb83fa33..1888baf6017 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -376,5 +376,11 @@ Evaluate BODY for each created map. '((1 . 1) (2 . 5) (3 . 0))) '((3 . 0) (2 . 9) (1 . 6))))) +(ert-deftest test-map-plist-pcase () + (let ((plist '(:one 1 :two 2))) + (should (equal (pcase-let (((map :one (:two two)) plist)) + (list one two)) + '(1 2))))) + (provide 'map-tests) ;;; map-tests.el ends here diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 7d354d6ecde..05770d6b58a 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -349,49 +349,108 @@ Must called from within a `tar-mode' buffer." (goto-char (point-min)) (should (re-search-forward re nil t))))))) + +;;; Package Menu tests + +(defmacro with-package-menu-test (&rest body) + "Set up Package Menu (\"*Packages*\") buffer for testing." + (declare (indent 0) (debug (([&rest form]) body))) + `(with-package-test () + (let ((buf (package-list-packages))) + (unwind-protect + (progn ,@body) + (kill-buffer buf))))) + (ert-deftest package-test-update-listing () "Ensure installed package status is updated." - (with-package-test () - (let ((buf (package-list-packages))) - (search-forward-regexp "^ +simple-single") - (package-menu-mark-install) - (package-menu-execute) - (run-hooks 'post-command-hook) - (should (package-installed-p 'simple-single)) - (switch-to-buffer "*Packages*") - (goto-char (point-min)) - (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) - (goto-char (point-min)) - (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)) - (kill-buffer buf)))) + (with-package-menu-test + (search-forward-regexp "^ +simple-single") + (package-menu-mark-install) + (package-menu-execute) + (run-hooks 'post-command-hook) + (should (package-installed-p 'simple-single)) + (switch-to-buffer "*Packages*") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+\\(available\\|new\\)" nil t)))) + +(ert-deftest package-test-list-filter-by-archive () + "Ensure package list is filtered correctly by archive version." + (with-package-menu-test + ;; TODO: Add another package archive to test filtering, because + ;; the testing environment currently only has one. + (package-menu-filter-by-archive "gnu") + (goto-char (point-min)) + (should (looking-at "^\\s-+multi-file")) + (should (= (count-lines (point-min) (point-max)) 4)) + (should-error (package-menu-filter-by-archive "non-existent archive")))) + +(ert-deftest package-test-list-filter-by-keyword () + "Ensure package list is filtered correctly by package keyword." + (with-package-menu-test + (package-menu-filter-by-keyword "frobnicate") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single" nil t)) + (should (= (count-lines (point-min) (point-max)) 1)) + (should-error (package-menu-filter-by-keyword "non-existent-keyword")))) (ert-deftest package-test-list-filter-by-name () "Ensure package list is filtered correctly by package name." - (with-package-test () - (let ((buf (package-list-packages))) - (package-menu-filter-by-name "tetris") - (goto-char (point-min)) - (should (re-search-forward "^\\s-+tetris" nil t)) - (should (= (count-lines (point-min) (point-max)) 1)) - (kill-buffer buf)))) + (with-package-menu-test () + (package-menu-filter-by-name "tetris") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+tetris" nil t)) + (should (= (count-lines (point-min) (point-max)) 1)))) + +(ert-deftest package-test-list-filter-by-status () + "Ensure package list is filtered correctly by package status." + (with-package-menu-test + (package-menu-filter-by-status "available") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+multi-file" nil t)) + (should (= (count-lines (point-min) (point-max)) 4)) + ;; No installed packages in default environment. + (should-error (package-menu-filter-by-status "installed")))) + +(ert-deftest package-test-list-filter-by-version () + (with-package-menu-test + (should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) ) + +(defun package-test-filter-by-version (version predicate name) + (with-package-menu-test + (package-menu-filter-by-version version predicate) + (goto-char (point-min)) + ;; We just check that the given package is included in the + ;; listing. One could be more ambitious. + (should (re-search-forward name)))) + +(ert-deftest package-test-list-filter-by-version-= () + "Ensure package list is filtered correctly by package version (=)." + (package-test-filter-by-version "1.1" '= "^\\s-+simple-two-depend")) + +(ert-deftest package-test-list-filter-by-version-< () + "Ensure package list is filtered correctly by package version (<)." + (package-test-filter-by-version "1.2" '< "^\\s-+simple-two-depend")) + +(ert-deftest package-test-list-filter-by-version-> () + "Ensure package list is filtered correctly by package version (>)." + (package-test-filter-by-version "1.0" '> "^\\s-+simple-two-depend")) (ert-deftest package-test-list-clear-filter () "Ensure package list filter is cleared correctly." - (with-package-test () - (let ((buf (package-list-packages))) - (let ((num-packages (count-lines (point-min) (point-max)))) - (should (> num-packages 1)) - (package-menu-filter-by-name "tetris") - (should (= (count-lines (point-min) (point-max)) 1)) - (package-menu-clear-filter) - (should (= (count-lines (point-min) (point-max)) num-packages))) - (kill-buffer buf)))) + (with-package-menu-test + (let ((num-packages (count-lines (point-min) (point-max)))) + (package-menu-filter-by-name "tetris") + (should (= (count-lines (point-min) (point-max)) 1)) + (package-menu-clear-filter) + (should (= (count-lines (point-min) (point-max)) num-packages))))) (ert-deftest package-test-update-archives () "Test updating package archives." (with-package-test () (let ((buf (package-list-packages))) - (package-menu-refresh) + (revert-buffer) (search-forward-regexp "^ +simple-single") (package-menu-mark-install) (package-menu-execute) @@ -399,7 +458,7 @@ Must called from within a `tar-mode' buffer." (let ((package-test-data-dir (expand-file-name "package-resources/newer-versions" package-test-file-dir))) (setq package-archives `(("gnu" . ,package-test-data-dir))) - (package-menu-refresh) + (revert-buffer) ;; New version should be available and old version should be installed (goto-char (point-min)) @@ -411,7 +470,7 @@ Must called from within a `tar-mode' buffer." (package-menu-mark-upgrades) (package-menu-execute) - (package-menu-refresh) + (revert-buffer) (should (package-installed-p 'simple-single '(1 4))))))) (ert-deftest package-test-update-archives-async () @@ -573,7 +632,7 @@ Must called from within a `tar-mode' buffer." (should (progn (package-install 'signed-bad) 'noerror))) ;; Check if the installed package status is updated. (let ((buf (package-list-packages))) - (package-menu-refresh) + (revert-buffer) (should (re-search-forward "^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-" nil t)) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index eaf39680e48..30c8f794577 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -74,7 +74,7 @@ left alone when opening a URL in an external browser." (urls nil) (ffap-url-fetcher (lambda (url) (push url urls) nil))) (should-not (ffap-other-window "https://www.gnu.org")) - (should (equal (current-window-configuration) old)) + (should (compare-window-configurations (current-window-configuration) old)) (should (equal urls '("https://www.gnu.org"))))) (provide 'ffap-tests) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index e9dc7532d59..39156fbb5dc 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -200,8 +200,7 @@ Return nil when any other file notification watch is still active." (setq file-notify-debug nil password-cache-expiry nil - tramp-verbose 0 - tramp-message-show-message nil) + tramp-verbose 0) ;; This should happen on hydra only. (when (getenv "EMACS_HYDRA_CI") @@ -929,17 +928,18 @@ delivered." ;; Modify file. We wait for a second, in order to have ;; another timestamp. (ert-with-message-capture captured-messages - (sleep-for 1) - (write-region - "another text" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (file-notify--test-wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - captured-messages)) - (should (string-match "another text" (buffer-string)))) + (let ((inhibit-message t)) + (sleep-for 1) + (write-region + "another text" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (file-notify--test-wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + captured-messages)) + (should (string-match "another text" (buffer-string))))) ;; Stop file notification. Autorevert shall still work via polling. (file-notify-rm-watch auto-revert-notify-watch-descriptor) @@ -953,17 +953,18 @@ delivered." ;; have another timestamp. One second seems to be too ;; short. And Cygwin sporadically requires more than two. (ert-with-message-capture captured-messages - (sleep-for (if (eq system-type 'cygwin) 3 2)) - (write-region - "foo bla" nil file-notify--test-tmpfile nil 'no-message) - - ;; Check, that the buffer has been reverted. - (file-notify--test-wait-for-events - timeout - (string-match - (format-message "Reverting buffer `%s'." (buffer-name buf)) - captured-messages)) - (should (string-match "foo bla" (buffer-string)))) + (let ((inhibit-message t)) + (sleep-for (if (eq system-type 'cygwin) 3 2)) + (write-region + "foo bla" nil file-notify--test-tmpfile nil 'no-message) + + ;; Check, that the buffer has been reverted. + (file-notify--test-wait-for-events + timeout + (string-match + (format-message "Reverting buffer `%s'." (buffer-name buf)) + captured-messages)) + (should (string-match "foo bla" (buffer-string))))) ;; Stop autorevert, in order to cleanup descriptor. (auto-revert-mode -1)) diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 4c808d8372e..d2dc3d24aec 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -56,28 +56,28 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-macro () - (let ((regexp "a Lisp macro in .subr\.el") + (let ((regexp "a Lisp macro in .subr\\.el") (result (help-fns-tests--describe-function 'when))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defun () - (let ((regexp "a compiled Lisp function in .subr\.el") + (let ((regexp "a compiled Lisp function in .subr\\.el") (result (help-fns-tests--describe-function 'last))) (should (string-match regexp result)))) (ert-deftest help-fns-test-lisp-defsubst () - (let ((regexp "a compiled Lisp function in .subr\.el") + (let ((regexp "a compiled Lisp function in .subr\\.el") (result (help-fns-tests--describe-function 'posn-window))) (should (string-match regexp result)))) (ert-deftest help-fns-test-alias-to-defun () - (let ((regexp "an alias for .set-file-modes. in .subr\.el") + (let ((regexp "an alias for .set-file-modes. in .subr\\.el") (result (help-fns-tests--describe-function 'chmod))) (should (string-match regexp result)))) (ert-deftest help-fns-test-bug23887 () "Test for https://debbugs.gnu.org/23887 ." - (let ((regexp "an alias for .re-search-forward. in .subr\.el") + (let ((regexp "an alias for .re-search-forward. in .subr\\.el") (result (help-fns-tests--describe-function 'search-forward-regexp))) (should (string-match regexp result)))) @@ -123,4 +123,41 @@ Return first line of the output of (describe-function-1 FUNC)." (goto-char (point-min)) (should (looking-at "^font-lock-comment-face is ")))) + +;;; Tests for describe-keymap +(ert-deftest help-fns-test-find-keymap-name () + (should (equal (help-fns-find-keymap-name lisp-mode-map) 'lisp-mode-map)) + ;; Follow aliasing. + (unwind-protect + (progn + (defvaralias 'foo-test-map 'lisp-mode-map) + (should (equal (help-fns-find-keymap-name foo-test-map) 'lisp-mode-map))) + (makunbound 'foo-test-map))) + +(ert-deftest help-fns-test-describe-keymap/symbol () + (describe-keymap 'minibuffer-local-must-match-map) + (with-current-buffer "*Help*" + (should (looking-at "^minibuffer-local-must-match-map is")))) + +(ert-deftest help-fns-test-describe-keymap/value () + (describe-keymap minibuffer-local-must-match-map) + (with-current-buffer "*Help*" + (should (looking-at "^key")))) + +(ert-deftest help-fns-test-describe-keymap/not-keymap () + (should-error (describe-keymap nil)) + (should-error (describe-keymap emacs-version))) + +(ert-deftest help-fns-test-describe-keymap/let-bound () + (let ((foobar minibuffer-local-must-match-map)) + (describe-keymap foobar) + (with-current-buffer "*Help*" + (should (looking-at "^key"))))) + +(ert-deftest help-fns-test-describe-keymap/dynamically-bound-no-file () + (setq help-fns-test--describe-keymap-foo minibuffer-local-must-match-map) + (describe-keymap 'help-fns-test--describe-keymap-foo) + (with-current-buffer "*Help*" + (should (looking-at "^help-fns-test--describe-keymap-foo is")))) + ;;; help-fns-tests.el ends here diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index 8dadb920547..2211cae305b 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -82,7 +82,7 @@ (test1 '((mode . org-mode) (or (size-gt . 10000) (and (not (starred-name)) - (directory . "\<org\>"))))) + (directory . "<org>"))))) (test2 '((or (mode . emacs-lisp-mode) (file-extension . "elc?") (and (starred-name) (name . "elisp")) (mode . lisp-interaction-mode)))) diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el index 82ea2078f16..ec77e65271d 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el @@ -299,7 +299,7 @@ implementations: (list " var var)) (dolist (linos (seq-partition newval 8)) (insert (mapconcat #'number-to-string linos " ") "\n")) - (insert ")\)")) + (insert "))")) (defun ucs-normalize-check-failing-lines () (interactive) diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el index ec283c86f55..09e05b62a25 100644 --- a/test/lisp/net/sasl-scram-rfc-tests.el +++ b/test/lisp/net/sasl-scram-rfc-tests.el @@ -1,4 +1,4 @@ -;;; sasl-scram-rfc-tests.el --- tests for SCRAM-SHA-1 -*- lexical-binding: t; -*- +;;; sasl-scram-rfc-tests.el --- tests for SCRAM -*- lexical-binding: t; -*- ;; Copyright (C) 2014-2020 Free Software Foundation, Inc. @@ -19,7 +19,7 @@ ;;; Commentary: -;; Test cases from RFC 5802. +;; Test cases from RFC 5802 and RFC 7677. ;;; Code: @@ -47,4 +47,26 @@ (sasl-scram-sha-1-authenticate-server client (vector nil "v=rmF9pqV8S7suAoZWja4dJRkFsKQ= ")))) +(require 'sasl-scram-sha256) + +(ert-deftest sasl-scram-sha-256-test () + ;; The following strings are taken from section 3 of RFC 7677. + (let ((client + (sasl-make-client (sasl-find-mechanism '("SCRAM-SHA-256")) + "user" + "imap" + "localhost")) + (data "r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096") + (c-nonce "rOprNGfwEbeRWgbNEkqO") + (sasl-read-passphrase + (lambda (_prompt) (copy-sequence "pencil")))) + (sasl-client-set-property client 'c-nonce c-nonce) + (should + (equal + (sasl-scram-sha-256-client-final-message client (vector nil data)) + "c=biws,r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,p=dHzbZapWIk4jUhN+Ute9ytag9zjfMHgsqmmiz7AndVQ=")) + + ;; This should not throw an error: + (sasl-scram-sha-256-authenticate-server client (vector nil "v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4=")))) + ;;; sasl-scram-rfc-tests.el ends here diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 3229d2b6506..b3fc129ef08 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -60,7 +60,6 @@ (setq password-cache-expiry nil tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil - tramp-message-show-message nil tramp-persistency-file-name nil tramp-verbose 0) @@ -971,4 +970,5 @@ If INTERACTIVE is non-nil, the tests are run interactively." "^tramp-archive")) (provide 'tramp-archive-tests) + ;;; tramp-archive-tests.el ends here diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 47d51767c5c..9409cc2a39f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -50,6 +50,7 @@ (require 'vc-hg) (declare-function tramp-find-executable "tramp-sh") +(declare-function tramp-get-remote-gid "tramp-sh") (declare-function tramp-get-remote-path "tramp-sh") (declare-function tramp-get-remote-perl "tramp-sh") (declare-function tramp-get-remote-stat "tramp-sh") @@ -67,13 +68,13 @@ (defvar tramp-remote-path) (defvar tramp-remote-process-environment) -;; Needed for Emacs 24. -(defvar inhibit-message) ;; Needed for Emacs 25. (defvar connection-local-criteria-alist) (defvar connection-local-profile-alist) ;; Needed for Emacs 26. (defvar async-shell-command-width) +;; Needed for Emacs 27. +(defvar shell-command-dont-erase-buffer) ;; Beautify batch mode. (when noninteractive @@ -100,8 +101,8 @@ (add-to-list 'tramp-default-host-alist `("\\`mock\\'" nil ,(system-name))) - ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in - ;; batch mode only, therefore. + ;; Emacs's Makefile sets $HOME to a nonexistent value. Needed + ;; in batch mode only, therefore. (unless (and (null noninteractive) (file-directory-p "~/")) (setenv "HOME" temporary-file-directory)) (format "/mock::%s" temporary-file-directory))) @@ -112,7 +113,6 @@ remote-file-name-inhibit-cache nil tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil - tramp-message-show-message nil tramp-persistency-file-name nil tramp-verbose 0) @@ -177,7 +177,6 @@ Print the content of the Tramp connection and debug buffers, if properly. BODY shall not contain a timeout." (declare (indent 1) (debug (natnump body))) `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0))) - (tramp-message-show-message t) (debug-ignored-errors (append '("^make-symbolic-link not supported$" @@ -2039,7 +2038,7 @@ properly. BODY shall not contain a timeout." "/method:host:/:/path//foo")) ;; Forwhatever reasons, the following tests let Emacs crash for - ;; Emacs 24 and Emacs 25, occasionally. No idea what's up. + ;; Emacs 25, occasionally. No idea what's up. (when (tramp--test-emacs26-p) (should (string-equal (substitute-in-file-name "/method:host://~foo") "/~foo")) @@ -2218,11 +2217,10 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Bug#10085. (when (tramp--test-enabled) ;; Packages like tramp-gvfs.el might be disabled. - (dolist (n-e '(nil t)) + (dolist (non-essential '(nil t)) ;; We must clear `tramp-default-method'. On hydra, it is "ftp", ;; which ruins the tests. - (let ((non-essential n-e) - (tramp-default-method + (let ((tramp-default-method (file-remote-p tramp-test-temporary-file-directory 'method)) (host (file-remote-p tramp-test-temporary-file-directory 'host))) (dolist @@ -2238,7 +2236,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should (string-equal (file-name-as-directory file) - (if (tramp-completion-mode-p) + (if non-essential file (concat file (if (tramp--test-ange-ftp-p) "/" "./"))))) (should (string-equal (file-name-directory file) file)) (should (string-equal (file-name-nondirectory file) ""))))))) @@ -2376,7 +2374,7 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Check message. ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1. (with-no-warnings (when (symbol-plist 'ert-with-message-capture) - (let ((tramp-message-show-message t)) + (let (inhibit-message) (dolist (noninteractive (unless (tramp--test-ange-ftp-p) '(nil t))) (dolist (visit '(nil t "string" no-message)) @@ -2393,14 +2391,14 @@ This checks also `file-name-as-directory', `file-name-directory', tramp--test-messages)))))))) ;; Do not overwrite if excluded. - (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)) + (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t)) ;; Ange-FTP. ((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) ;; `mustbenew' is passed to Tramp since Emacs 26.1. (when (tramp--test-emacs26-p) (should-error - (cl-letf (((symbol-function 'y-or-n-p) 'ignore) + (cl-letf (((symbol-function #'y-or-n-p) #'ignore) ;; Ange-FTP. ((symbol-function 'yes-or-no-p) 'ignore)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) @@ -3115,22 +3113,38 @@ This tests also `access-file', `file-readable-p', (file-remote-p tmp-name1) (replace-regexp-in-string "/" "//" (file-remote-p tmp-name1 'localname)))) + ;; `file-ownership-preserved-p' is implemented only in tramp-sh.el. + (test-file-ownership-preserved-p (tramp--test-sh-p)) attr) (unwind-protect (progn + ;; A sticky bit could damage the `file-ownership-preserved-p' test. + (when + (and test-file-ownership-preserved-p + (zerop (logand + #o1000 + (file-modes tramp-test-temporary-file-directory)))) + (write-region "foo" nil tmp-name1) + (setq test-file-ownership-preserved-p + (= (tramp-compat-file-attribute-group-id + (file-attributes tmp-name1)) + (tramp-get-remote-gid + (tramp-dissect-file-name tmp-name1) 'integer))) + (delete-file tmp-name1)) + (should-error (access-file tmp-name1 "error") :type tramp-file-missing) ;; `file-ownership-preserved-p' should return t for - ;; non-existing files. It is implemented only in tramp-sh.el. - (when (tramp--test-sh-p) + ;; non-existing files. + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-readable-p tmp-name1)) (should (file-regular-p tmp-name1)) (should-not (access-file tmp-name1 "error")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) ;; We do not test inodes and device numbers. @@ -3160,16 +3174,16 @@ This tests also `access-file', `file-readable-p', (should (stringp (tramp-compat-file-attribute-group-id attr))) (tramp--test-ignore-make-symbolic-link-error - (should-error - (access-file tmp-name2 "error") - :type tramp-file-missing) - (when (tramp--test-sh-p) + (should-error + (access-file tmp-name2 "error") + :type tramp-file-missing) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name2 'group))) (make-symbolic-link tmp-name1 tmp-name2) (should (file-exists-p tmp-name2)) (should (file-symlink-p tmp-name2)) (should-not (access-file tmp-name2 "error")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name2 'group))) (setq attr (file-attributes tmp-name2)) (should @@ -3200,7 +3214,7 @@ This tests also `access-file', `file-readable-p', (tramp-dissect-file-name tmp-name3)))) (delete-file tmp-name2)) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (delete-file tmp-name1) (make-directory tmp-name1) @@ -3208,7 +3222,7 @@ This tests also `access-file', `file-readable-p', (should (file-readable-p tmp-name1)) (should-not (file-regular-p tmp-name1)) (should-not (access-file tmp-name1 "")) - (when (tramp--test-sh-p) + (when test-file-ownership-preserved-p (should (file-ownership-preserved-p tmp-name1 'group))) (setq attr (file-attributes tmp-name1)) (should (eq (tramp-compat-file-attribute-type attr) t))) @@ -3420,11 +3434,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :type 'file-already-exists)) (when (tramp--test-expensive-test) ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) (should-error (make-symbolic-link tmp-name1 tmp-name2 0) :type 'file-already-exists))) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) (make-symbolic-link tmp-name1 tmp-name2 0) (should (string-equal @@ -3496,11 +3510,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (add-name-to-file tmp-name1 tmp-name2) :type 'file-already-exists) ;; A number means interactive case. - (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) + (cl-letf (((symbol-function #'yes-or-no-p) #'ignore)) (should-error (add-name-to-file tmp-name1 tmp-name2 0) :type 'file-already-exists)) - (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t))) (add-name-to-file tmp-name1 tmp-name2 0) (should (file-regular-p tmp-name2))) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) @@ -4020,10 +4034,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (tramp-change-syntax orig-syntax)))) - (dolist (n-e '(nil t)) + (dolist (non-essential '(nil t)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) - (let ((non-essential n-e) - (tmp-name (tramp--test-make-temp-name nil quoted))) + (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect (progn @@ -4181,7 +4194,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (setq proc (start-file-process "test1" (current-buffer) "cat")) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4224,7 +4237,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (set-process-filter proc (lambda (p s) (with-current-buffer (process-buffer p) (insert s)))) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4242,13 +4255,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) - ;; `make-process' has been inserted in Emacs 25.1. It supports file - ;; name handlers since Emacs 27. + ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) - (tmp-name (tramp--test-make-temp-name nil quoted)) + (tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (tramp--test-make-temp-name 'local quoted)) kill-buffer-query-functions proc) (with-no-warnings (should-not (make-process))) @@ -4262,7 +4275,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4278,13 +4291,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Simple process using a file. (unwind-protect (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) + (write-region "foo" nil tmp-name1) + (should (file-exists-p tmp-name1)) (setq proc (with-no-warnings (make-process :name "test2" :buffer (current-buffer) - :command `("cat" ,(file-name-nondirectory tmp-name)) + :command `("cat" ,(file-name-nondirectory tmp-name1)) :file-handler t))) (should (processp proc)) ;; Read output. @@ -4296,7 +4309,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc) - (delete-file tmp-name))) + (delete-file tmp-name1))) ;; Process filter. (unwind-protect @@ -4311,7 +4324,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) ;; Read output. (with-timeout (10 (tramp--test-timeout-handler)) @@ -4337,7 +4350,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :file-handler t))) (should (processp proc)) (should (equal (process-status proc) 'run)) - (process-send-string proc "foo") + (process-send-string proc "foo\n") (process-send-eof proc) (delete-process proc) ;; Read output. @@ -4345,36 +4358,67 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (while (accept-process-output proc 0 nil t))) ;; We cannot use `string-equal', because tramp-adb.el ;; echoes also the sent string. And a remote macOS sends - ;; a slightly modified string. - (should (string-match "killed.*\n\\'" (buffer-string)))) + ;; a slightly modified string. On MS-Windows, + ;; `delete-process' sends an unknown signal. + (should + (string-match + (if (eq system-type 'windows-nt) + "unknown signal\n\\'" "killed.*\n\\'") + (buffer-string)))) ;; Cleanup. (ignore-errors (delete-process proc))) - ;; Process with stderr. tramp-adb.el doesn't support it (yet). - (unless (tramp--test-adb-p) - (let ((stderr (generate-new-buffer "*stderr*"))) - (unwind-protect + ;; Process with stderr buffer. + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test5" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr stderr + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (delete-process proc) + (with-current-buffer stderr + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) + + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (kill-buffer stderr)))) + + ;; Process with stderr file. + (dolist (tmpfile `(,tmp-name1 ,tmp-name2)) + (unwind-protect + (with-temp-buffer + (setq proc + (with-no-warnings + (make-process + :name "test6" :buffer (current-buffer) + :command '("cat" "/does-not-exist") + :stderr tmpfile + :file-handler t))) + (should (processp proc)) + ;; Read stderr. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc nil nil t))) + (delete-process proc) (with-temp-buffer - (setq proc - (with-no-warnings - (make-process - :name "test5" :buffer (current-buffer) - :command '("cat" "/") - :stderr stderr - :file-handler t))) - (should (processp proc)) - ;; Read stderr. - (with-current-buffer stderr - (with-timeout (10 (tramp--test-timeout-handler)) - (while (= (point-min) (point-max)) - (while (accept-process-output proc 0 nil t)))) - (should - (string-match "^cat:.* Is a directory" (buffer-string))))) + (insert-file-contents tmpfile) + (should + (string-match + "cat:.* No such file or directory" (buffer-string))))) - ;; Cleanup. - (ignore-errors (delete-process proc)) - (ignore-errors (kill-buffer stderr)))))))) + ;; Cleanup. + (ignore-errors (delete-process proc)) + (ignore-errors (delete-file tmpfile))))))) (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." @@ -4388,10 +4432,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; order to establish the connection prior running an asynchronous ;; process. (let ((default-directory (file-truename tramp-test-temporary-file-directory)) + (delete-exited-processes t) kill-buffer-query-functions proc) (unwind-protect (with-temp-buffer - (setq proc (start-file-process "test" (current-buffer) "sleep" "10")) + (setq proc (start-file-process-shell-command + "test" (current-buffer) + "trap 'echo boom; exit 1' 2; sleep 100")) (should (processp proc)) (should (process-live-p proc)) (should (equal (process-status proc) 'run)) @@ -4399,7 +4446,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (interrupt-process proc)) ;; Let the process accept the interrupt. (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output proc nil nil 0))) + (while (process-live-p proc) + (while (accept-process-output proc 0 nil t)))) (should-not (process-live-p proc)) ;; An interrupted process cannot be interrupted, again. (should-error @@ -4409,14 +4457,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc))))) +(defun tramp--test-async-shell-command + (command output-buffer &optional error-buffer input) + "Like `async-shell-command', reading the output. +INPUT, if non-nil, is a string sent to the process." + (async-shell-command command output-buffer error-buffer) + (let ((proc (get-buffer-process output-buffer)) + (delete-exited-processes t)) + (when (stringp input) + (process-send-string proc input)) + (with-timeout + ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) + (while (or (accept-process-output proc nil nil t) (process-live-p proc)))) + (accept-process-output proc nil nil t))) + (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." (with-temp-buffer - (async-shell-command command (current-buffer)) - (with-timeout - ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) + (tramp--test-async-shell-command command (current-buffer)) (buffer-substring-no-properties (point-min) (point-max)))) (ert-deftest tramp-test32-shell-command () @@ -4435,111 +4493,177 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (inhibit-message t) kill-buffer-query-functions) - ;; Test ordinary `shell-command'. - (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - (should - (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) - (buffer-string)))) - - ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (dolist (this-shell-command + '(;; Synchronously. + shell-command + ;; Asynchronously. + tramp--test-async-shell-command)) - ;; Test `shell-command' with error buffer. - (let ((stderr (generate-new-buffer "*stderr*"))) + ;; Test ordinary `{async-}shell-command'. (unwind-protect (with-temp-buffer - (shell-command "error" (current-buffer) stderr) - (should (= (point-min) (point-max))) + (write-region "foo" nil tmp-name) + (should (file-exists-p tmp-name)) + (funcall + this-shell-command + (format "ls %s" (file-name-nondirectory tmp-name)) + (current-buffer)) + ;; `ls' could produce colorized output. + (goto-char (point-min)) + (while + (re-search-forward tramp-display-escape-sequence-regexp nil t) + (replace-match "" nil nil)) (should - (string-match - "error:.+not found" - (with-current-buffer stderr (buffer-string))))) + (string-equal + (format "%s\n" (file-name-nondirectory tmp-name)) + (buffer-string)))) ;; Cleanup. - (ignore-errors (kill-buffer stderr)))) + (ignore-errors (delete-file tmp-name))) - ;; Test ordinary `async-shell-command'. + ;; Test `{async-}shell-command' with error buffer. + (let ((stderr (generate-new-buffer "*stderr*"))) + (unwind-protect + (with-temp-buffer + (funcall + this-shell-command + "echo foo >&2; echo bar" (current-buffer) stderr) + (should (string-equal "bar\n" (buffer-string))) + ;; Check stderr. + (with-current-buffer stderr + (should (string-equal "foo\n" (buffer-string))))) + + ;; Cleanup. + (ignore-errors (kill-buffer stderr))))) + + ;; Test sending string to `async-shell-command'. (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) - (async-shell-command - (format "ls %s" (file-name-nondirectory tmp-name)) - (current-buffer)) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) + (tramp--test-async-shell-command + "read line; ls $line" (current-buffer) nil + ;; String to be sent. + (format "%s\n" (file-name-nondirectory tmp-name))) (should (string-equal - (format "%s\n" (file-name-nondirectory tmp-name)) + ;; tramp-adb.el echoes, so we must add the string. + (if (tramp--test-adb-p) + (format + "%s\n%s\n" + (file-name-nondirectory tmp-name) + (file-name-nondirectory tmp-name)) + (format "%s\n" (file-name-nondirectory tmp-name))) (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (ignore-errors (delete-file tmp-name))))) - ;; Test sending string to `async-shell-command'. + ;; Test `async-shell-command-width'. It exists since Emacs 26.1, + ;; but seems to work since Emacs 27.1 only. + (when (and (tramp--test-sh-p) (tramp--test-emacs27-p)) + (let* ((async-shell-command-width 1024) + (default-directory tramp-test-temporary-file-directory) + (cols (ignore-errors + (read (tramp--test-shell-command-to-string-asynchronously + "tput cols"))))) + (when (natnump cols) + (should (= cols async-shell-command-width)))))) + +;; This test is inspired by Bug#39067. +(ert-deftest tramp-test32-shell-command-dont-erase-buffer () + "Check `shell-command-dont-erase-buffer'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) + ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. + (skip-unless (tramp--test-emacs27-p)) + + ;; We check both the local and remote case, in order to guarantee + ;; that they behave similar. + (dolist (default-directory + `(,temporary-file-directory ,tramp-test-temporary-file-directory)) + (let ((buffer (generate-new-buffer "foo")) + ;; Suppress nasty messages. + (inhibit-message t) + point kill-buffer-query-functions) (unwind-protect - (with-temp-buffer - (write-region "foo" nil tmp-name) - (should (file-exists-p tmp-name)) - (async-shell-command "read line; ls $line" (current-buffer)) - (process-send-string - (get-buffer-process (current-buffer)) - (format "%s\n" (file-name-nondirectory tmp-name))) - ;; Read output. - (with-timeout (10 (tramp--test-timeout-handler)) - (while (accept-process-output - (get-buffer-process (current-buffer)) nil nil t))) - ;; `ls' could produce colorized output. - (goto-char (point-min)) - (while - (re-search-forward tramp-display-escape-sequence-regexp nil t) - (replace-match "" nil nil)) - ;; We cannot use `string-equal', because tramp-adb.el - ;; echoes also the sent string. - (should - (string-match - (format "\\`%s" (regexp-quote (file-name-nondirectory tmp-name))) - (buffer-string)))) + (progn + ;; Don't erase if buffer is the current one. Point is not moved. + (let (shell-command-dont-erase-buffer) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + (should (= point (point))))) + + ;; Erase if the buffer is not current one. + (let (shell-command-dont-erase-buffer) + (with-current-buffer buffer + (erase-buffer) + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (with-temp-buffer + (shell-command "echo baz" buffer)) + (should (string-equal "baz\n" (buffer-string))) + (should (= point (point))))) + + ;; Erase if buffer is the current one, but + ;; `shell-command-dont-erase-buffer' is set to `erase'. + (let ((shell-command-dont-erase-buffer 'erase)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "baz\n" (buffer-string))) + (should (= (point) (point-max))))) + + ;; Don't erase if `shell-command-dont-erase-buffer' is set + ;; to `beg-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'beg-last-out)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + (should (= point (point))))) + + ;; Don't erase if `shell-command-dont-erase-buffer' is set + ;; to `end-last-out'. Check point. + (let ((shell-command-dont-erase-buffer 'end-last-out)) + (with-temp-buffer + (insert "bar") + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (point-max))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + (should (= (point) (point-max))))) + + ;; Don't erase if `shell-command-dont-erase-buffer' is set + ;; to `save-point'. Check point. + (let ((shell-command-dont-erase-buffer 'save-point)) + (with-temp-buffer + (insert "bar") + (goto-char (1- (point-max))) + (setq point (point)) + (should (string-equal "bar" (buffer-string))) + (should (= (point) (1- (point-max)))) + (shell-command "echo baz" (current-buffer)) + (should (string-equal "barbaz\n" (buffer-string))) + (should (= point (point)))))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) - - ;; Test `async-shell-command-width'. Since Emacs 27.1. - (when (ignore-errors - (and (boundp 'async-shell-command-width) - (zerop (call-process "tput" nil nil nil "cols")) - (zerop (process-file "tput" nil nil nil "cols")))) - (let (async-shell-command-width) - (should - (string-equal - (format "%s\n" (car (process-lines "tput" "cols"))) - (tramp--test-shell-command-to-string-asynchronously - "tput cols"))) - (setq async-shell-command-width 1024) - (should - (string-equal - "1024\n" - (tramp--test-shell-command-to-string-asynchronously - "tput cols")))))))) + (ignore-errors (kill-buffer buffer)))))) ;; This test is inspired by Bug#23952. (ert-deftest tramp-test33-environment-variables () @@ -4949,13 +5073,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (error (ert-skip "`vc-create-repo' not supported"))) ;; The structure of VC-FILESET is not documented. Let's ;; hope it won't change. - (condition-case nil - (vc-register - (list (car vc-handled-backends) - (list (file-name-nondirectory tmp-name2)))) - ;; `vc-register' has changed its arguments in Emacs - ;; 25.1. Let's skip it for older Emacsen. - (error (skip-unless (tramp--test-emacs25-p)))) + (vc-register + (list (car vc-handled-backends) + (list (file-name-nondirectory tmp-name2)))) ;; vc-git uses an own process sentinel, Tramp's sentinel ;; for flushing the cache isn't used. (dired-uncache (concat (file-remote-p default-directory) "/")) @@ -5212,12 +5332,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) -(defun tramp--test-emacs25-p () - "Check for Emacs version >= 25.1. -Some semantics has been changed for there, w/o new functions or -variables, so we check the Emacs version directly." - (>= emacs-major-version 25)) - (defun tramp--test-emacs26-p () "Check for Emacs version >= 26.1. Some semantics has been changed for there, w/o new functions or @@ -5753,7 +5867,7 @@ Use the `ls' command." ;; Since Emacs 27.1. (skip-unless (fboundp 'file-system-info)) - ;; `file-system-info' exists since Emacs 27. We don't want to see + ;; `file-system-info' exists since Emacs 27.1. We don't want to see ;; compiler warnings for older Emacsen. (let ((fsi (with-no-warnings (file-system-info tramp-test-temporary-file-directory)))) @@ -6146,12 +6260,14 @@ Since it unloads Tramp, it shall be the last test to run." (and (or (and (boundp x) (null (local-variable-if-set-p x))) (and (functionp x) (null (autoloadp (symbol-function x))))) (string-match "^tramp" (symbol-name x)) + ;; `tramp-completion-mode' is autoloaded in Emacs < 28.1. + (not (eq 'tramp-completion-mode x)) (not (string-match "^tramp\\(-archive\\)?--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) (ert-fail (format "`%s' still bound" x))))) ;; The defstruct `tramp-file-name' and all its internal functions - ;; shall be purged. `cl--find-class' must be protected in Emacs 24. - (with-no-warnings (should-not (cl--find-class 'tramp-file-name))) + ;; shall be purged. + (should-not (cl--find-class 'tramp-file-name)) (mapatoms (lambda (x) (and (functionp x) @@ -6191,11 +6307,10 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Investigate, why `tramp-test11-copy-file' and `tramp-test12-rename-file' ;; do not work properly for `nextcloud'. -;; * Fix `tramp-test29-start-file-process' and -;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). ;; * Implement `tramp-test31-interrupt-process' for `adb'. ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. A remote ;; file name operation cannot run in the timer. Remove `:unstable' tag? (provide 'tramp-tests) + ;;; tramp-tests.el ends here diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 650782bc53c..ed23e064743 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -70,7 +70,6 @@ (setq password-cache-expiry nil shadow-debug (getenv "EMACS_HYDRA_CI") tramp-verbose 0 - tramp-message-show-message nil ;; On macOS, `temporary-file-directory' is a symlinked directory. temporary-file-directory (file-truename temporary-file-directory) shadow-test-remote-temporary-file-directory diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 276df795fca..eb3b0296ea8 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -392,6 +392,48 @@ See bug#35036." (should (equal ?\s (char-syntax ?\n)))))) +;;; undo tests + +(defun simple-tests--exec (cmds) + (dolist (cmd cmds) + (setq last-command this-command) + (setq this-command cmd) + (run-hooks 'pre-command-hook) + (command-execute cmd) + (run-hooks 'post-command-hook) + (undo-boundary))) + +(ert-deftest simple-tests--undo () + (with-temp-buffer + (buffer-enable-undo) + (dolist (x '("a" "b" "c" "d" "e")) + (insert x) + (undo-boundary)) + (should (equal (buffer-string) "abcde")) + (simple-tests--exec '(undo undo)) + (should (equal (buffer-string) "abc")) + (simple-tests--exec '(backward-char undo)) + (should (equal (buffer-string) "abcd")) + (simple-tests--exec '(undo)) + (should (equal (buffer-string) "abcde")) + (simple-tests--exec '(backward-char undo undo)) + (should (equal (buffer-string) "abc")) + (simple-tests--exec '(backward-char undo-redo)) + (should (equal (buffer-string) "abcd")) + (simple-tests--exec '(undo)) + (should (equal (buffer-string) "abc")) + (simple-tests--exec '(backward-char undo-redo undo-redo)) + (should (equal (buffer-string) "abcde")) + (simple-tests--exec '(undo undo)) + (should (equal (buffer-string) "abc")) + (simple-tests--exec '(backward-char undo-only undo-only)) + (should (equal (buffer-string) "a")) + (simple-tests--exec '(backward-char undo-redo undo-redo)) + (should (equal (buffer-string) "abc")) + (simple-tests--exec '(backward-char undo-redo undo-redo)) + (should (equal (buffer-string) "abcde")) + )) + ;;; undo auto-boundary tests (ert-deftest undo-auto-boundary-timer () (should @@ -427,7 +469,7 @@ See bug#35036." (with-temp-buffer (switch-to-buffer (current-buffer)) (setq buffer-undo-list nil) - (insert "a\nb\n\c\n") + (insert "a\nb\nc\n") (goto-char (point-max)) ;; We use a keyboard macro because it adds undo events in the same ;; way as if a user were involved. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 059d52b1b6f..a583d57d2e8 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -244,6 +244,27 @@ (error-message-string (should-error (version-to-list "beta22_8alpha3"))) "Invalid version syntax: `beta22_8alpha3' (must start with a number)")))) +(ert-deftest subr-test-version-list-< () + (should (version-list-< '(0) '(1))) + (should (version-list-< '(0 9) '(1 0))) + (should (version-list-< '(1 -1) '(1 0))) + (should (version-list-< '(1 -2) '(1 -1))) + (should (not (version-list-< '(1) '(0)))) + (should (not (version-list-< '(1 1) '(1 0)))) + (should (not (version-list-< '(1) '(1 0)))) + (should (not (version-list-< '(1 0) '(1 0 0))))) + +(ert-deftest subr-test-version-list-= () + (should (version-list-= '(1) '(1))) + (should (version-list-= '(1 0) '(1))) + (should (not (version-list-= '(0) '(1))))) + +(ert-deftest subr-test-version-list-<= () + (should (version-list-<= '(0) '(1))) + (should (version-list-<= '(1) '(1))) + (should (version-list-<= '(1 0) '(1))) + (should (not (version-list-<= '(1) '(0))))) + (defun subr-test--backtrace-frames-with-backtrace-frame (base) "Reference implementation of `backtrace-frames'." (let ((idx 0) diff --git a/test/lisp/textmodes/conf-mode-tests.el b/test/lisp/textmodes/conf-mode-tests.el index 814cb06b960..7e870269959 100644 --- a/test/lisp/textmodes/conf-mode-tests.el +++ b/test/lisp/textmodes/conf-mode-tests.el @@ -162,7 +162,7 @@ image/tiff tiff tif (ert-deftest conf-test-toml-mode () ;; From `conf-toml-mode' docstring. (with-temp-buffer - (insert "\[entry] + (insert "[entry] value = \"some string\"") (goto-char (point-min)) (conf-toml-mode) diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index d229fddc48d..e75e84b0221 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -38,9 +38,7 @@ (cl-letf (((symbol-function 'time-stamp-conv-warn) (lambda (old-format _new) (ert-fail - (format "Unexpected format warning for '%s'" old-format)))) - ((symbol-function 'system-name) - (lambda () "test-system-name.example.org"))) + (format "Unexpected format warning for '%s'" old-format))))) ;; Not all reference times are used in all tests; ;; suppress the byte compiler's "unused" warning. (list ref-time1 ref-time2 ref-time3) @@ -56,6 +54,13 @@ (apply orig-time-stamp-string-fn ts-format ,reference-time nil)))) ,@body)) +(defmacro with-time-stamp-system-name (name &rest body) + "Force (system-name) to return NAME while evaluating BODY." + (declare (indent defun)) + `(cl-letf (((symbol-function 'system-name) + (lambda () ,name))) + ,@body)) + (defmacro time-stamp-should-warn (form) "Similar to `should' but verifies that a format warning is generated." `(let ((warning-count 0)) @@ -170,6 +175,20 @@ ;; triggering the tests above. (time-stamp))))))) +(ert-deftest time-stamp-custom-format-tabs-expand () + "Test that Tab characters expand in the format but not elsewhere." + (with-time-stamp-test-env + (let ((time-stamp-start "Updated in: <\t") + ;; Tabs in the format should expand + (time-stamp-format "\t%Y\t") + (time-stamp-end "\t>")) + (with-time-stamp-test-time ref-time1 + (with-temp-buffer + (insert "Updated in: <\t\t>") + (time-stamp) + (should (equal (buffer-string) + "Updated in: <\t 2006 \t>"))))))) + (ert-deftest time-stamp-custom-inserts-lines () "Test that time-stamp inserts lines or not, as directed." (with-time-stamp-test-env @@ -194,19 +213,46 @@ (time-stamp) (should (equal (buffer-string) buffer-expected-2line))))))) +(ert-deftest time-stamp-custom-end () + "Test that time-stamp finds the end pattern on the correct line." + (with-time-stamp-test-env + (let ((time-stamp-start "Updated on: <") + (time-stamp-format "%Y-%m-%d") + (time-stamp-end ">") ;changed later in the test + (buffer-original-contents "Updated on: <\n>\n") + (buffer-expected-time-stamped "Updated on: <2006-01-02\n>\n")) + (with-time-stamp-test-time ref-time1 + (with-temp-buffer + (insert buffer-original-contents) + ;; time-stamp-end is not on same line, should not be seen + (time-stamp) + (should (equal (buffer-string) buffer-original-contents)) + + ;; add a newline to time-stamp-end, so it starts on same line + (setq time-stamp-end "\n>") + (time-stamp) + (should (equal (buffer-string) buffer-expected-time-stamped))))))) + (ert-deftest time-stamp-custom-count () "Test that time-stamp updates no more than time-stamp-count templates." (with-time-stamp-test-env (let ((time-stamp-start "TS: <") (time-stamp-format "%Y-%m-%d") - (time-stamp-count 1) ;changed later in the test + (time-stamp-count 0) ;changed later in the test (buffer-expected-once "TS: <2006-01-02>\nTS: <>") (buffer-expected-twice "TS: <2006-01-02>\nTS: <2006-01-02>")) (with-time-stamp-test-time ref-time1 (with-temp-buffer (insert "TS: <>\nTS: <>") (time-stamp) + ;; even with count = 0, expect one time stamp + (should (equal (buffer-string) buffer-expected-once))) + (with-temp-buffer + (setq time-stamp-count 1) + (insert "TS: <>\nTS: <>") + (time-stamp) (should (equal (buffer-string) buffer-expected-once)) + (setq time-stamp-count 2) (time-stamp) (should (equal (buffer-string) buffer-expected-twice))))))) @@ -488,26 +534,35 @@ (ert-deftest time-stamp-format-non-date-conversions () "Test time-stamp formats for non-date items." (with-time-stamp-test-env - ;; implemented and documented since 1995 - (should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char - (should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char - (should (equal (time-stamp-string "%f" ref-time1) "time-stamped-file")) - (should - (equal (time-stamp-string "%F" ref-time1) "/emacs/test/time-stamped-file")) - (should (equal (time-stamp-string "%h" ref-time1) "test-mail-host-name")) - ;; documented 1995-2019 - (should (equal - (time-stamp-string "%s" ref-time1) "test-system-name.example.org")) - (should (equal (time-stamp-string "%U" ref-time1) "100%d Tester")) - (should (equal (time-stamp-string "%u" ref-time1) "test-logname")) - ;; implemented since 2001, documented since 2019 - (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester")) - (should (equal (time-stamp-string "%l" ref-time1) "test-logname")) - ;; implemented since 2007, documented since 2019 - (should (equal - (time-stamp-string "%Q" ref-time1) "test-system-name.example.org")) - (should (equal - (time-stamp-string "%q" ref-time1) "test-system-name")))) + (with-time-stamp-system-name "test-system-name.example.org" + ;; implemented and documented since 1995 + (should (equal (time-stamp-string "%%" ref-time1) "%")) ;% last char + (should (equal (time-stamp-string "%%P" ref-time1) "%P")) ;% not last char + (should (equal (time-stamp-string "%f" ref-time1) "time-stamped-file")) + (should (equal (time-stamp-string "%F" ref-time1) + "/emacs/test/time-stamped-file")) + (with-temp-buffer + (should (equal (time-stamp-string "%f" ref-time1) "(no file)")) + (should (equal (time-stamp-string "%F" ref-time1) "(no file)"))) + (should (equal (time-stamp-string "%h" ref-time1) "test-mail-host-name")) + (let ((mail-host-address nil)) + (should (equal (time-stamp-string "%h" ref-time1) + "test-system-name.example.org"))) + ;; documented 1995-2019 + (should (equal (time-stamp-string "%s" ref-time1) + "test-system-name.example.org")) + (should (equal (time-stamp-string "%U" ref-time1) "100%d Tester")) + (should (equal (time-stamp-string "%u" ref-time1) "test-logname")) + ;; implemented since 2001, documented since 2019 + (should (equal (time-stamp-string "%L" ref-time1) "100%d Tester")) + (should (equal (time-stamp-string "%l" ref-time1) "test-logname")) + ;; implemented since 2007, documented since 2019 + (should (equal (time-stamp-string "%Q" ref-time1) + "test-system-name.example.org")) + (should (equal (time-stamp-string "%q" ref-time1) "test-system-name"))) + (with-time-stamp-system-name "sysname-no-dots" + (should (equal (time-stamp-string "%Q" ref-time1) "sysname-no-dots")) + (should (equal (time-stamp-string "%q" ref-time1) "sysname-no-dots"))))) (ert-deftest time-stamp-format-ignored-modifiers () "Test additional args allowed (but ignored) to allow for future expansion." @@ -538,6 +593,13 @@ ;;; Tests of helper functions +(ert-deftest time-stamp-helper-string-defaults () + "Test that time-stamp-string defaults its format to time-stamp-format." + (with-time-stamp-test-env + (should (equal (time-stamp-string nil ref-time1) + (time-stamp-string time-stamp-format ref-time1))) + (should (equal (time-stamp-string 'not-a-string ref-time1) nil)))) + (ert-deftest time-stamp-helper-zone-type-p () "Test time-stamp-zone-type-p." (should (time-stamp-zone-type-p t)) diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index 4eb776a0555..aa1ab1648f8 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -51,3 +51,10 @@ (should-not (eq x y)) (dotimes (i 4) (should (eql (aref x i) (aref y i)))))) + +;; Bug#39207 +(ert-deftest aset-nbytes-change () + (let ((s (make-string 1 ?a))) + (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e)) + (aset s 0 c) + (should (equal s (make-string 1 c)))))) diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 6f14d4f7fa3..48d2e86a605 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -60,8 +60,9 @@ (should (eq 0 (string-match (concat "#<module function " - "\\(at \\(0x\\)?[[:xdigit:]]+\\( from .*\\)?" - "\\|Fmod_test_sum from .*\\)>") + "\\(at \\(0x\\)?[[:xdigit:]]+ " + "with data 0x1234\\( from .*\\)?" + "\\|Fmod_test_sum with data 0x1234 from .*\\)>") (prin1-to-string (nth 1 descr))))) (should (= (nth 2 descr) 3))) (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument) @@ -97,6 +98,7 @@ changes." (rx bos "#<module function " (or "Fmod_test_sum" (and "at 0x" (+ hex-digit))) + " with data 0x1234" (? " from " (* nonl) "mod-test" (* nonl) ) ">" eos) (prin1-to-string func))))) @@ -384,4 +386,42 @@ Interactively, you can try hitting \\[keyboard-quit] to quit." (ert-info ((format "input: %d" input)) (should (= (mod-test-double input) (* 2 input)))))) +(ert-deftest module-darwin-secondary-suffix () + "Check that on Darwin, both .so and .dylib suffixes work. +See Bug#36226." + (skip-unless (eq system-type 'darwin)) + (should (member ".dylib" load-suffixes)) + (should (member ".so" load-suffixes)) + ;; Preserve the old `load-history'. This is needed for some of the + ;; other unit tests that indirectly rely on `load-history'. + (let ((load-history load-history) + (dylib (concat mod-test-file ".dylib")) + (so (concat mod-test-file ".so"))) + (should (file-regular-p dylib)) + (should-not (file-exists-p so)) + (add-name-to-file dylib so) + (unwind-protect + (load so nil nil :nosuffix :must-suffix) + (delete-file so)))) + +(ert-deftest module/function-finalizer () + "Test that module function finalizers are properly called." + ;; We create and leak a couple of module functions with attached + ;; finalizer. Creating only one function risks spilling it to the + ;; stack, where it wouldn't be garbage-collected. However, with one + ;; hundred functions, there should be at least one that's + ;; unreachable. + (dotimes (_ 100) + (mod-test-make-function-with-finalizer)) + (cl-destructuring-bind (valid-before invalid-before) + (mod-test-function-finalizer-calls) + (should (zerop invalid-before)) + (garbage-collect) + (cl-destructuring-bind (valid-after invalid-after) + (mod-test-function-finalizer-calls) + (should (zerop invalid-after)) + ;; We don't require exactly 100 invocations of the finalizer, + ;; but at least one. + (should (> valid-after valid-before))))) + ;;; emacs-module-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 60be2c6c2d7..c6ceae4a00e 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -858,6 +858,22 @@ (puthash k k h))) (should (= 100 (hash-table-count h))))) +(ert-deftest test-sxhash-equal () + (should (= (sxhash-equal (* most-positive-fixnum most-negative-fixnum)) + (sxhash-equal (* most-positive-fixnum most-negative-fixnum)))) + (should (= (sxhash-equal (make-string 1000 ?a)) + (sxhash-equal (make-string 1000 ?a)))) + (should (= (sxhash-equal (point-marker)) + (sxhash-equal (point-marker)))) + (should (= (sxhash-equal (make-vector 1000 (make-string 10 ?a))) + (sxhash-equal (make-vector 1000 (make-string 10 ?a))))) + (should (= (sxhash-equal (make-bool-vector 1000 t)) + (sxhash-equal (make-bool-vector 1000 t)))) + (should (= (sxhash-equal (make-char-table nil (make-string 10 ?a))) + (sxhash-equal (make-char-table nil (make-string 10 ?a))))) + (should (= (sxhash-equal (record 'a (make-string 10 ?a))) + (sxhash-equal (record 'a (make-string 10 ?a)))))) + (ert-deftest test-secure-hash () (should (equal (secure-hash 'md5 "foobar") "3858f62230ac3c915f300c664312c63f")) diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 1426b0145e0..6efd8bed302 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -157,22 +157,6 @@ literals (Bug#20852)." (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))))) -(ert-deftest lread-tests--old-style-backquotes () - "Check that loading doesn't accept old-style backquotes." - (lread-tests--with-temp-file file-name - (write-region "(` (a b))" nil file-name) - (let ((data (should-error (load file-name nil :nomessage :nosuffix)))) - (should (equal (cdr data) - (list (concat (format-message "Loading `%s': " file-name) - "old-style backquotes detected!"))))))) - -(ert-deftest lread-tests--force-new-style-backquotes () - (let ((data (should-error (read "(` (a b))")))) - (should (equal (cdr data) '("Old-style backquotes detected!")))) - (should (equal (let ((force-new-style-backquotes t)) - (read "(` (a b))")) - '(`(a b))))) - (ert-deftest lread-lread--substitute-object-in-subtree () (let ((x (cons 0 1))) (setcar x x) diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index 6a661afeff9..f9372e37b11 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -161,7 +161,7 @@ what failed, if anything; valid values are 'search-failed, 'compilation-failed and nil. I compare the beginning/end of each group with their expected values. This is done with either BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil. -BOUNDS-REF is a sequence \[start-ref0 end-ref0 start-ref1 +BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1 end-ref1 ....] while SUBSTRING-REF is the expected substring obtained by indexing the input string by start/end-ref. @@ -327,7 +327,7 @@ emacs requires an extra symbol character" (defun regex-tests-BOOST-frob-escapes (s ispattern) "Mangle \\ the way it is done in frob_escapes() in regex-tests-BOOST.c in glibc: \\t, \\n, \\r are interpreted; -\\\\, \\^, \{, \\|, \} are unescaped for the string (not +\\\\, \\^, \\{, \\|, \\} are unescaped for the string (not pattern)" ;; this is all similar to (regex-tests-unextend) @@ -505,7 +505,7 @@ differences in behavior.") (cond ;; pattern - ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*i?\\)$" nil t)) + ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*\\)$" nil t)) (setq icase (string= "i" (match-string 2)) pattern (regex-tests-unextend (match-string 1)))) |