aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-06-26 10:03:48 -0400
committerStefan Monnier2019-06-26 10:03:48 -0400
commit698ff554ac2699ec48fefc85a1307cbc4a183b0d (patch)
treea7b7592f7973f81cad4410366d313e790616907e
parent9233865b7005831e63755eb84ae7da060f878a55 (diff)
downloademacs-698ff554ac2699ec48fefc85a1307cbc4a183b0d.tar.gz
emacs-698ff554ac2699ec48fefc85a1307cbc4a183b0d.zip
* lisp/calc/calc-ext.el (math-scalarp): Fix typo
-rw-r--r--.dir-locals.el2
-rw-r--r--.gitignore1
-rw-r--r--lisp/Makefile.in7
-rw-r--r--lisp/abbrev.el3
-rw-r--r--lisp/calc/calc-math.el17
-rw-r--r--lisp/calendar/time-date.el4
-rw-r--r--lisp/completion.el2
-rw-r--r--lisp/composite.el5
-rw-r--r--lisp/elec-pair.el3
-rw-r--r--lisp/electric.el38
-rw-r--r--lisp/emacs-lisp/bytecomp.el20
-rw-r--r--lisp/emacs-lisp/generic.el66
-rw-r--r--lisp/emacs-lisp/lisp-mode.el1
-rw-r--r--lisp/emacs-lisp/package.el20
-rw-r--r--lisp/emacs-lisp/pcase.el29
-rw-r--r--lisp/emacs-lisp/regexp-opt.el2
-rw-r--r--lisp/emacs-lisp/smie.el8
-rw-r--r--lisp/emulation/viper-cmd.el120
-rw-r--r--lisp/emulation/viper-ex.el2
-rw-r--r--lisp/emulation/viper-util.el2
-rw-r--r--lisp/erc/erc-track.el29
-rw-r--r--lisp/erc/erc.el2
-rw-r--r--lisp/eshell/esh-util.el9
-rw-r--r--lisp/follow.el142
-rw-r--r--lisp/format-spec.el2
-rw-r--r--lisp/frame.el37
-rw-r--r--lisp/gnus/gnus-art.el284
-rw-r--r--lisp/gnus/gnus-cloud.el10
-rw-r--r--lisp/gnus/gnus-topic.el9
-rw-r--r--lisp/gnus/gnus-util.el114
-rw-r--r--lisp/gnus/nnimap.el2
-rw-r--r--lisp/help-fns.el7
-rw-r--r--lisp/international/quail.el2
-rw-r--r--lisp/mh-e/mh-funcs.el4
-rw-r--r--lisp/minibuffer.el73
-rw-r--r--lisp/net/ldap.el109
-rw-r--r--lisp/net/rcirc.el4
-rw-r--r--lisp/newcomment.el99
-rw-r--r--lisp/nxml/rng-uri.el9
-rw-r--r--lisp/nxml/xmltok.el10
-rw-r--r--lisp/org/org.el29
-rw-r--r--lisp/pcomplete.el161
-rw-r--r--lisp/progmodes/cc-mode.el59
-rw-r--r--lisp/progmodes/cperl-mode.el53
-rw-r--r--lisp/progmodes/gud.el6
-rw-r--r--lisp/progmodes/modula2.el21
-rw-r--r--lisp/progmodes/python.el4
-rw-r--r--lisp/startup.el17
-rw-r--r--lisp/subr.el23
-rw-r--r--lisp/term/xterm.el1
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/textmodes/fill.el6
-rw-r--r--lisp/window.el2
-rw-r--r--lisp/xt-mouse.el2
-rw-r--r--src/alloc.c23
-rw-r--r--src/keyboard.c2
-rw-r--r--test/lisp/electric-tests.el9
-rw-r--r--test/lisp/minibuffer-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el2
59 files changed, 915 insertions, 818 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index ffd65c88027..5db74799ade 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,6 @@
1((nil . ((tab-width . 8) 1((nil . ((tab-width . 8)
2 (sentence-end-double-space . t) 2 (sentence-end-double-space . t)
3 (fill-column . 70) 3 (fill-column . 79)
4 (bug-reference-url-format . "https://debbugs.gnu.org/%s"))) 4 (bug-reference-url-format . "https://debbugs.gnu.org/%s")))
5 (c-mode . ((c-file-style . "GNU") 5 (c-mode . ((c-file-style . "GNU")
6 (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) 6 (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK"))
diff --git a/.gitignore b/.gitignore
index e75df8b8b61..389fb450d86 100644
--- a/.gitignore
+++ b/.gitignore
@@ -251,7 +251,6 @@ gnustmp*
251 251
252# Version control and locks. 252# Version control and locks.
253*.orig 253*.orig
254*.rej
255*.swp 254*.swp
256*~ 255*~
257.#* 256.#*
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index ee2c2091770..68c8c1259d4 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -63,7 +63,8 @@ EMACS = ../src/emacs${EXEEXT}
63EMACSOPT = -batch --no-site-file --no-site-lisp 63EMACSOPT = -batch --no-site-file --no-site-lisp
64 64
65# Extra flags to pass to the byte compiler 65# Extra flags to pass to the byte compiler
66BYTE_COMPILE_EXTRA_FLAGS = 66BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-force-lexical-warnings t)'
67
67# For example to not display the undefined function warnings you can use this: 68# For example to not display the undefined function warnings you can use this:
68# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))' 69# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
69# The example above is just for developers, it should not be used by default. 70# The example above is just for developers, it should not be used by default.
@@ -85,7 +86,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
85 86
86# Set load-prefer-newer for the benefit of the non-bootstrappers. 87# Set load-prefer-newer for the benefit of the non-bootstrappers.
87BYTE_COMPILE_FLAGS = \ 88BYTE_COMPILE_FLAGS = \
88 --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) 89 --eval '(setq load-prefer-newer t byte-compile-force-lexical-warnings t)' $(BYTE_COMPILE_EXTRA_FLAGS)
89 90
90# Files to compile before others during a bootstrap. This is done to 91# Files to compile before others during a bootstrap. This is done to
91# speed up the bootstrap process. They're ordered by size, so we use 92# speed up the bootstrap process. They're ordered by size, so we use
@@ -316,7 +317,7 @@ compile-targets: $(TARGETS)
316# Compile all the Elisp files that need it. Beware: it approximates 317# Compile all the Elisp files that need it. Beware: it approximates
317# 'no-byte-compile', so watch out for false-positives! 318# 'no-byte-compile', so watch out for false-positives!
318compile-main: gen-lisp compile-clean 319compile-main: gen-lisp compile-clean
319 @(cd $(lisp) && \ 320 @(cd $(lisp) && \
320 els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ 321 els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
321 for el in ${MAIN_FIRST} $$els; do \ 322 for el in ${MAIN_FIRST} $$els; do \
322 test -f $$el || continue; \ 323 test -f $$el || continue; \
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 3d0a843e375..f8c82238a31 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -648,7 +648,8 @@ either a single abbrev table or a list of abbrev tables."
648 ;; to treat the distinction between a single table and a list of tables. 648 ;; to treat the distinction between a single table and a list of tables.
649 (cond 649 (cond
650 ((consp tables) tables) 650 ((consp tables) tables)
651 ((vectorp tables) (list tables)) 651 ((abbrev-table-p tables) (list tables))
652 (tables (signal 'wrong-type-argument (list 'abbrev-table-p tables)))
652 (t 653 (t
653 (let ((tables (if (listp local-abbrev-table) 654 (let ((tables (if (listp local-abbrev-table)
654 (append local-abbrev-table 655 (append local-abbrev-table
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 4ca8515989b..f9a420090ee 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -31,9 +31,8 @@
31(require 'calc-macs) 31(require 'calc-macs)
32 32
33 33
34;;; Find out how many 9s in 9.9999... will give distinct Emacs floats, 34;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
35;;; then back off by one. 35;; then back off by one.
36
37(defvar math-emacs-precision 36(defvar math-emacs-precision
38 (let* ((n 1) 37 (let* ((n 1)
39 (x 9) 38 (x 9)
@@ -46,9 +45,9 @@
46 (1- n)) 45 (1- n))
47 "The number of digits in an Emacs float.") 46 "The number of digits in an Emacs float.")
48 47
49;;; Find the largest power of 10 which is an Emacs float, 48;; Find the largest power of 10 which is an Emacs float,
50;;; then back off by one so that any float d.dddd...eN 49;; then back off by one so that any float d.dddd...eN
51;;; is an Emacs float, for acceptable d.dddd.... 50;; is an Emacs float, for acceptable d.dddd....
52 51
53(defvar math-largest-emacs-expt 52(defvar math-largest-emacs-expt
54 (let ((x 1) 53 (let ((x 1)
@@ -367,9 +366,9 @@ If this can't be done, return NIL."
367 (message "Angles measured in radians"))) 366 (message "Angles measured in radians")))
368 367
369 368
370;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] 369;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
371;;; This method takes advantage of the fact that Newton's method starting 370;; This method takes advantage of the fact that Newton's method starting
372;;; with an overestimate always works, even using truncating integer division! 371;; with an overestimate always works, even using truncating integer division!
373(defun math-isqrt (a) 372(defun math-isqrt (a)
374 (cond ((Math-zerop a) a) 373 (cond ((Math-zerop a) a)
375 ((not (natnump a)) 374 ((not (natnump a))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2c0280ccf3b..dad87dc8c97 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -156,9 +156,9 @@ If DATE lacks timezone information, GMT is assumed."
156 (let ((overflow-error '(error "Specified time is not representable"))) 156 (let ((overflow-error '(error "Specified time is not representable")))
157 (if (equal err overflow-error) 157 (if (equal err overflow-error)
158 (signal (car err) (cdr err)) 158 (signal (car err) (cdr err))
159 (condition-case err 159 (condition-case-unless-debug err
160 (encode-time (parse-time-string 160 (encode-time (parse-time-string
161 (timezone-make-date-arpa-standard date))) 161 (timezone-make-date-arpa-standard date)))
162 (error 162 (error
163 (if (equal err overflow-error) 163 (if (equal err overflow-error)
164 (signal (car err) (cdr err)) 164 (signal (car err) (cdr err))
diff --git a/lisp/completion.el b/lisp/completion.el
index b9c3a21f5ea..d5450998204 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -2221,7 +2221,7 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
2221(defun completion-before-command () 2221(defun completion-before-command ()
2222 (funcall (or (and (symbolp this-command) 2222 (funcall (or (and (symbolp this-command)
2223 (get this-command 'completion-function)) 2223 (get this-command 'completion-function))
2224 'use-completion-under-or-before-point))) 2224 #'use-completion-under-or-before-point)))
2225 2225
2226;; Lisp mode diffs. 2226;; Lisp mode diffs.
2227 2227
diff --git a/lisp/composite.el b/lisp/composite.el
index e0d0721f16d..926fa44c88e 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,4 +1,4 @@
1;;; composite.el --- support character composition 1;;; composite.el --- support character composition -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2001-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2019 Free Software Foundation, Inc.
4 4
@@ -588,7 +588,6 @@ All non-spacing characters have this function in
588 (as (lglyph-ascent glyph)) 588 (as (lglyph-ascent glyph))
589 (de (lglyph-descent glyph)) 589 (de (lglyph-descent glyph))
590 (ce (/ (+ lb rb) 2)) 590 (ce (/ (+ lb rb) 2))
591 (w (lglyph-width glyph))
592 xoff yoff) 591 xoff yoff)
593 (cond 592 (cond
594 ((and class (>= class 200) (<= class 240)) 593 ((and class (>= class 200) (<= class 240))
@@ -689,9 +688,7 @@ All non-spacing characters have this function in
689 688
690(defun compose-gstring-for-dotted-circle (gstring direction) 689(defun compose-gstring-for-dotted-circle (gstring direction)
691 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle 690 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
692 (dc-id (lglyph-code dc))
693 (fc (lgstring-glyph gstring 1)) ; glyph of the following char 691 (fc (lgstring-glyph gstring 1)) ; glyph of the following char
694 (fc-id (lglyph-code fc))
695 (gstr (and nil (font-shape-gstring gstring direction)))) 692 (gstr (and nil (font-shape-gstring gstring direction))))
696 (if (and gstr 693 (if (and gstr
697 (or (= (lgstring-glyph-len gstr) 1) 694 (or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 5fb9d751e25..6728525a547 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -551,7 +551,8 @@ happened."
551 (goto-char pos) 551 (goto-char pos)
552 (funcall electric-pair-inhibit-predicate 552 (funcall electric-pair-inhibit-predicate
553 last-command-event))))) 553 last-command-event)))))
554 (save-excursion (electric-pair--insert pair))))) 554 (let ((electric-indent--destination (point-marker)))
555 (save-excursion (electric-pair--insert pair))))))
555 (_ 556 (_
556 (when (and (if (functionp electric-pair-open-newline-between-pairs) 557 (when (and (if (functionp electric-pair-open-newline-between-pairs)
557 (funcall electric-pair-open-newline-between-pairs) 558 (funcall electric-pair-open-newline-between-pairs)
diff --git a/lisp/electric.el b/lisp/electric.el
index 53e53bd975c..c70e60b720a 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -220,6 +220,14 @@ If `indent-line-function' is one of those, then `electric-indent-mode' will
220not try to reindent lines. It is normally better to make the major 220not try to reindent lines. It is normally better to make the major
221mode set `electric-indent-inhibit', but this can be used as a workaround.") 221mode set `electric-indent-inhibit', but this can be used as a workaround.")
222 222
223(defun electric-indent--inhibited-p ()
224 (or electric-indent-inhibit
225 (memq indent-line-function
226 electric-indent-functions-without-reindent)))
227
228(defvar electric-indent--destination nil
229 "If non-nil, position to which point will be later restored.")
230
223(defun electric-indent-post-self-insert-function () 231(defun electric-indent-post-self-insert-function ()
224 "Function that `electric-indent-mode' adds to `post-self-insert-hook'. 232 "Function that `electric-indent-mode' adds to `post-self-insert-hook'.
225This indents if the hook `electric-indent-functions' returns non-nil, 233This indents if the hook `electric-indent-functions' returns non-nil,
@@ -261,26 +269,26 @@ or comment."
261 (when at-newline 269 (when at-newline
262 (let ((before (copy-marker (1- pos) t))) 270 (let ((before (copy-marker (1- pos) t)))
263 (save-excursion 271 (save-excursion
264 (unless 272 (unless (electric-indent--inhibited-p)
265 (or (memq indent-line-function
266 electric-indent-functions-without-reindent)
267 electric-indent-inhibit)
268 ;; Don't reindent the previous line if the 273 ;; Don't reindent the previous line if the
269 ;; indentation function is not a real one. 274 ;; indentation function is not a real one.
270 (goto-char before) 275 (goto-char before)
271 (condition-case-unless-debug () 276 (condition-case-unless-debug ()
272 (indent-according-to-mode) 277 (indent-according-to-mode)
273 (error (throw 'indent-error nil))) 278 (error (throw 'indent-error nil))))
274 ;; The goal here will be to remove the trailing 279 ;; The goal here will be to remove the trailing
275 ;; whitespace after reindentation of the previous line 280 ;; whitespace after reindentation of the previous line
276 ;; because that may have (re)introduced it. 281 ;; because that may have (re)introduced it.
277 (goto-char before) 282 (goto-char before)
278 ;; We were at EOL in marker `before' before the call 283 ;; We were at EOL in marker `before' before the call
279 ;; to `indent-according-to-mode' but after we may 284 ;; to `indent-according-to-mode' but after we may
280 ;; not be (Bug#15767). 285 ;; not be (Bug#15767).
281 (when (and (eolp)) 286 (when (and (eolp)
282 (delete-horizontal-space t)))))) 287 ;; Don't delete "trailing space" before point!
283 (unless (and electric-indent-inhibit 288 (not (and electric-indent--destination
289 (= (point) electric-indent--destination))))
290 (delete-horizontal-space t)))))
291 (unless (and (electric-indent--inhibited-p)
284 (not at-newline)) 292 (not at-newline))
285 (condition-case-unless-debug () 293 (condition-case-unless-debug ()
286 (indent-according-to-mode) 294 (indent-according-to-mode)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 431525431a4..d8ea33a160d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2981,7 +2981,7 @@ for symbols generated by the byte compiler itself."
2981 lexenv reserved-csts) 2981 lexenv reserved-csts)
2982 ;; OUTPUT-TYPE advises about how form is expected to be used: 2982 ;; OUTPUT-TYPE advises about how form is expected to be used:
2983 ;; 'eval or nil -> a single form, 2983 ;; 'eval or nil -> a single form,
2984 ;; 'progn or t -> a list of forms, 2984 ;; t -> a list of forms,
2985 ;; 'lambda -> body of a lambda, 2985 ;; 'lambda -> body of a lambda,
2986 ;; 'file -> used at file-level. 2986 ;; 'file -> used at file-level.
2987 (let ((byte-compile--for-effect for-effect) 2987 (let ((byte-compile--for-effect for-effect)
@@ -3044,21 +3044,19 @@ for symbols generated by the byte compiler itself."
3044 ;; a single atom, but that causes confusion if the docstring 3044 ;; a single atom, but that causes confusion if the docstring
3045 ;; uses the (file . pos) syntax. Besides, now that we have 3045 ;; uses the (file . pos) syntax. Besides, now that we have
3046 ;; the Lisp_Compiled type, the compiled form is faster. 3046 ;; the Lisp_Compiled type, the compiled form is faster.
3047 ;; eval -> atom, quote or (function atom atom atom) 3047 ;; eval/nil-> atom, quote or (function atom atom atom)
3048 ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) 3048 ;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
3049 ;; file -> as progn, but takes both quotes and atoms, and longer forms. 3049 ;; file -> as progn, but takes both quotes and atoms, and longer forms.
3050 (let (rest 3050 (let (body tmp)
3051 (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
3052 tmp body)
3053 (cond 3051 (cond
3054 ;; #### This should be split out into byte-compile-nontrivial-function-p. 3052 ;; #### This should be split out into byte-compile-nontrivial-function-p.
3055 ((or (eq output-type 'lambda) 3053 ((or (eq output-type 'lambda)
3056 (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) 3054 (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
3057 (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. 3055 (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
3058 (not (setq tmp (assq 'byte-return byte-compile-output))) 3056 (not (setq tmp (assq 'byte-return byte-compile-output)))
3059 (progn 3057 (let ((maycall t) ; t if we may make a funcall.
3060 (setq rest (nreverse 3058 (rest (nreverse
3061 (cdr (memq tmp (reverse byte-compile-output))))) 3059 (cdr (memq tmp (reverse byte-compile-output))))))
3062 (while 3060 (while
3063 (cond 3061 (cond
3064 ((memq (car (car rest)) '(byte-varref byte-constant)) 3062 ((memq (car (car rest)) '(byte-varref byte-constant))
@@ -3067,7 +3065,7 @@ for symbols generated by the byte compiler itself."
3067 (or (consp tmp) 3065 (or (consp tmp)
3068 (and (symbolp tmp) 3066 (and (symbolp tmp)
3069 (not (macroexp--const-symbol-p tmp))))) 3067 (not (macroexp--const-symbol-p tmp)))))
3070 (if maycall 3068 (if maycall ;;Why? --Stef
3071 (setq body (cons (list 'quote tmp) body))) 3069 (setq body (cons (list 'quote tmp) body)))
3072 (setq body (cons tmp body)))) 3070 (setq body (cons tmp body))))
3073 ((and maycall 3071 ((and maycall
@@ -3075,7 +3073,7 @@ for symbols generated by the byte compiler itself."
3075 (null (nthcdr 3 rest)) 3073 (null (nthcdr 3 rest))
3076 (setq tmp (get (car (car rest)) 'byte-opcode-invert)) 3074 (setq tmp (get (car (car rest)) 'byte-opcode-invert))
3077 (or (null (cdr rest)) 3075 (or (null (cdr rest))
3078 (and (memq output-type '(file progn t)) 3076 (and (memq output-type '(file t))
3079 (cdr (cdr rest)) 3077 (cdr (cdr rest))
3080 (eq (car (nth 1 rest)) 'byte-discard) 3078 (eq (car (nth 1 rest)) 'byte-discard)
3081 (progn (setq rest (cdr rest)) t)))) 3079 (progn (setq rest (cdr rest)) t))))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index e4ed745b25d..3b6ea12ecff 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -234,73 +234,13 @@ Some generic modes are defined in `generic-x.el'."
234 (cond 234 (cond
235 ((characterp end) (setq end (char-to-string end))) 235 ((characterp end) (setq end (char-to-string end)))
236 ((zerop (length end)) (setq end "\n"))) 236 ((zerop (length end)) (setq end "\n")))
237 (push (cons start end) normalized))) 237 (push (list start end) normalized)))
238 (nreverse normalized))) 238 (nreverse normalized)))
239 239
240(defun generic-set-comment-syntax (st comment-list)
241 "Set up comment functionality for generic mode."
242 (let ((chars nil)
243 (comstyles)
244 (comstyle "")
245 (comment-start nil))
246
247 ;; Go through all the comments.
248 (pcase-dolist (`(,start . ,end) comment-list)
249 (let ((comstyle
250 ;; Reuse comstyles if necessary.
251 (or (cdr (assoc start comstyles))
252 (cdr (assoc end comstyles))
253 ;; Otherwise, use a style not yet in use.
254 (if (not (rassoc "" comstyles)) "")
255 (if (not (rassoc "b" comstyles)) "b")
256 "c")))
257 (push (cons start comstyle) comstyles)
258 (push (cons end comstyle) comstyles)
259
260 ;; Setup the syntax table.
261 (if (= (length start) 1)
262 (modify-syntax-entry (aref start 0)
263 (concat "< " comstyle) st)
264 (let ((c0 (aref start 0)) (c1 (aref start 1)))
265 ;; Store the relevant info but don't update yet.
266 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
267 (push (cons c1 (concat (cdr (assoc c1 chars))
268 (concat "2" comstyle))) chars)))
269 (if (= (length end) 1)
270 (modify-syntax-entry (aref end 0)
271 (concat ">" comstyle) st)
272 (let ((c0 (aref end 0)) (c1 (aref end 1)))
273 ;; Store the relevant info but don't update yet.
274 (push (cons c0 (concat (cdr (assoc c0 chars))
275 (concat "3" comstyle))) chars)
276 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
277
278 ;; Process the chars that were part of a 2-char comment marker
279 (with-syntax-table st ;For `char-syntax'.
280 (dolist (cs (nreverse chars))
281 (modify-syntax-entry (car cs)
282 (concat (char-to-string (char-syntax (car cs)))
283 " " (cdr cs))
284 st)))))
285
286(defun generic-set-comment-vars (comment-list)
287 (when comment-list
288 (setq-local comment-start (caar comment-list))
289 (setq-local comment-end
290 (let ((end (cdar comment-list)))
291 (if (string-equal end "\n") "" end)))
292 (setq-local comment-start-skip
293 (concat (regexp-opt (mapcar #'car comment-list))
294 "+[ \t]*"))
295 (setq-local comment-end-skip
296 (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list))))))
297
298(defun generic-mode-set-comments (comment-list) 240(defun generic-mode-set-comments (comment-list)
299 "Set up comment functionality for generic mode." 241 "Set up comment functionality for generic mode."
300 (let ((st (make-syntax-table)) 242 (let ((st (make-syntax-table)))
301 (comment-list (generic--normalize-comments comment-list))) 243 (comment-set-syntax st comment-list)
302 (generic-set-comment-syntax st comment-list)
303 (generic-set-comment-vars comment-list)
304 (set-syntax-table st))) 244 (set-syntax-table st)))
305 245
306(defun generic-bracket-support () 246(defun generic-bracket-support ()
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index fa6dc98d04c..ac47d98359b 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -237,6 +237,7 @@
237 (eval-when-compile 237 (eval-when-compile
238 (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>")) 238 (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
239 limit t) 239 limit t)
240 ;; FIXME: If it's indented like `defun' then highlight the first arg!
240 (let ((sym (intern-soft (match-string 1)))) 241 (let ((sym (intern-soft (match-string 1))))
241 (when (or (special-form-p sym) 242 (when (or (special-form-p sym)
242 (and (macrop sym) 243 (and (macrop sym)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index b60a8a136a1..5b136bdf489 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1163,26 +1163,6 @@ The return result is a `package-desc'."
1163 (insert (format "Error while verifying signature %s:\n" sig-file))) 1163 (insert (format "Error while verifying signature %s:\n" sig-file)))
1164 (insert "\nCommand output:\n" (epg-context-error-output context)))))) 1164 (insert "\nCommand output:\n" (epg-context-error-output context))))))
1165 1165
1166(defmacro package--with-work-buffer (location file &rest body)
1167 "Run BODY in a buffer containing the contents of FILE at LOCATION.
1168LOCATION is the base location of a package archive, and should be
1169one of the URLs (or file names) specified in `package-archives'.
1170FILE is the name of a file relative to that base location.
1171
1172This macro retrieves FILE from LOCATION into a temporary buffer,
1173and evaluates BODY while that buffer is current. This work
1174buffer is killed afterwards. Return the last value in BODY."
1175 (declare (indent 2) (debug t)
1176 (obsolete package--with-response-buffer "25.1"))
1177 `(with-temp-buffer
1178 (if (string-match-p "\\`https?:" ,location)
1179 (url-insert-file-contents (concat ,location ,file))
1180 (unless (file-name-absolute-p ,location)
1181 (error "Archive location %s is not an absolute file name"
1182 ,location))
1183 (insert-file-contents (expand-file-name ,file ,location)))
1184 ,@body))
1185
1186(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) 1166(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys)
1187 "Access URL and run BODY in a buffer containing the response. 1167 "Access URL and run BODY in a buffer containing the response.
1188Point is after the headers when BODY runs. 1168Point is after the headers when BODY runs.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ae2cf8eb02f..07beb722fc3 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -97,11 +97,34 @@
97(declare-function get-edebug-spec "edebug" (symbol)) 97(declare-function get-edebug-spec "edebug" (symbol))
98(declare-function edebug-match "edebug" (cursor specs)) 98(declare-function edebug-match "edebug" (cursor specs))
99 99
100(defun pcase--get-macroexpander (s)
101 "Return the macroexpander for pcase pattern head S, or nil"
102 (let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment))))
103 (if em (cdr em)
104 (get s 'pcase-macroexpander))))
105
106(defmacro pcase-macrolet (bindings &rest body)
107 (let ((new-macros (if (consp (car-safe bindings))
108 (mapcar (lambda (binding)
109 (cons (car binding)
110 (eval (if (cddr binding)
111 `(lambda ,(cadr binding)
112 ,@(cddr binding))
113 (cadr binding))
114 lexical-binding)))
115 bindings)
116 (eval bindings lexical-binding)))
117 (old-pme (assq :pcase-macroexpander macroexpand-all-environment)))
118 (macroexpand-all (macroexp-progn body)
119 (cons (cons :pcase-macroexpander
120 (append new-macros old-pme))
121 macroexpand-all-environment))))
122
100(defun pcase--edebug-match-macro (cursor) 123(defun pcase--edebug-match-macro (cursor)
101 (let (specs) 124 (let (specs)
102 (mapatoms 125 (mapatoms
103 (lambda (s) 126 (lambda (s)
104 (let ((m (get s 'pcase-macroexpander))) 127 (let ((m (pcase--get-macroexpander s)))
105 (when (and m (get-edebug-spec m)) 128 (when (and m (get-edebug-spec m))
106 (push (cons (symbol-name s) (get-edebug-spec m)) 129 (push (cons (symbol-name s) (get-edebug-spec m))
107 specs))))) 130 specs)))))
@@ -193,7 +216,7 @@ Emacs Lisp manual for more information and examples."
193 (let (more) 216 (let (more)
194 ;; Collect all the extensions. 217 ;; Collect all the extensions.
195 (mapatoms (lambda (symbol) 218 (mapatoms (lambda (symbol)
196 (let ((me (get symbol 'pcase-macroexpander))) 219 (let ((me (pcase--get-macroexpander symbol)))
197 (when me 220 (when me
198 (push (cons symbol me) 221 (push (cons symbol me)
199 more))))) 222 more)))))
@@ -419,7 +442,7 @@ of the elements of LIST is performed as if by `pcase-let'.
419 ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) 442 ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
420 ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) 443 ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
421 (t 444 (t
422 (let* ((expander (get head 'pcase-macroexpander)) 445 (let* ((expander (pcase--get-macroexpander head))
423 (npat (if expander (apply expander (cdr pat))))) 446 (npat (if expander (apply expander (cdr pat)))))
424 (if (null npat) 447 (if (null npat)
425 (error (if expander 448 (error (if expander
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 00f72e284ad..a9b5df53c84 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -141,7 +141,7 @@ usually more efficient than that of a simplified version:
141 (completion-regexp-list nil) 141 (completion-regexp-list nil)
142 (open (cond ((stringp paren) paren) (paren "\\("))) 142 (open (cond ((stringp paren) paren) (paren "\\(")))
143 (sorted-strings (delete-dups 143 (sorted-strings (delete-dups
144 (sort (copy-sequence strings) 'string-lessp))) 144 (sort (copy-sequence strings) #'string-lessp)))
145 (re 145 (re
146 (cond 146 (cond
147 ;; No strings: return an unmatchable regexp. 147 ;; No strings: return an unmatchable regexp.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index f2163b243ee..47265962591 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -239,7 +239,7 @@ be either:
239 ;; (exp (exp (or "+" "*" "=" ..) exp)). 239 ;; (exp (exp (or "+" "*" "=" ..) exp)).
240 ;; Basically, make it EBNF (except for the specification of a separator in 240 ;; Basically, make it EBNF (except for the specification of a separator in
241 ;; the repetition, maybe). 241 ;; the repetition, maybe).
242 (let* ((nts (mapcar 'car bnf)) ;Non-terminals. 242 (let* ((nts (mapcar #'car bnf)) ;Non-terminals.
243 (first-ops-table ()) 243 (first-ops-table ())
244 (last-ops-table ()) 244 (last-ops-table ())
245 (first-nts-table ()) 245 (first-nts-table ())
@@ -258,7 +258,7 @@ be either:
258 (push resolver precs)) 258 (push resolver precs))
259 (t (error "Unknown resolver %S" resolver)))) 259 (t (error "Unknown resolver %S" resolver))))
260 (apply #'smie-merge-prec2s over 260 (apply #'smie-merge-prec2s over
261 (mapcar 'smie-precs->prec2 precs)))) 261 (mapcar #'smie-precs->prec2 precs))))
262 again) 262 again)
263 (dolist (rules bnf) 263 (dolist (rules bnf)
264 (let ((nt (car rules)) 264 (let ((nt (car rules))
@@ -489,7 +489,7 @@ CSTS is a list of pairs representing arcs in a graph."
489 res)) 489 res))
490 cycle))) 490 cycle)))
491 (mapconcat 491 (mapconcat
492 (lambda (elems) (mapconcat 'identity elems "=")) 492 (lambda (elems) (mapconcat #'identity elems "="))
493 (append names (list (car names))) 493 (append names (list (car names)))
494 " < "))) 494 " < ")))
495 495
@@ -559,7 +559,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
559 ;; Then eliminate trivial constraints iteratively. 559 ;; Then eliminate trivial constraints iteratively.
560 (let ((i 0)) 560 (let ((i 0))
561 (while csts 561 (while csts
562 (let ((rhvs (mapcar 'cdr csts)) 562 (let ((rhvs (mapcar #'cdr csts))
563 (progress nil)) 563 (progress nil))
564 (dolist (cst csts) 564 (dolist (cst csts)
565 (unless (memq (car cst) rhvs) 565 (unless (memq (car cst) rhvs)
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index bdb205ce7c8..e7c737d85ab 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -293,15 +293,15 @@
293 ;; desirable that viper-pre-command-sentinel is the last hook and 293 ;; desirable that viper-pre-command-sentinel is the last hook and
294 ;; viper-post-command-sentinel is the first hook. 294 ;; viper-post-command-sentinel is the first hook.
295 295
296 (remove-hook 'post-command-hook 'viper-post-command-sentinel) 296 (remove-hook 'post-command-hook #'viper-post-command-sentinel)
297 (add-hook 'post-command-hook 'viper-post-command-sentinel) 297 (add-hook 'post-command-hook #'viper-post-command-sentinel)
298 (remove-hook 'pre-command-hook 'viper-pre-command-sentinel) 298 (remove-hook 'pre-command-hook #'viper-pre-command-sentinel)
299 (add-hook 'pre-command-hook 'viper-pre-command-sentinel t) 299 (add-hook 'pre-command-hook #'viper-pre-command-sentinel t)
300 ;; These hooks will be added back if switching to insert/replace mode 300 ;; These hooks will be added back if switching to insert/replace mode
301 (remove-hook 'viper-post-command-hooks 301 (remove-hook 'viper-post-command-hooks
302 'viper-insert-state-post-command-sentinel 'local) 302 #'viper-insert-state-post-command-sentinel 'local)
303 (remove-hook 'viper-pre-command-hooks 303 (remove-hook 'viper-pre-command-hooks
304 'viper-insert-state-pre-command-sentinel 'local) 304 #'viper-insert-state-pre-command-sentinel 'local)
305 (setq viper-intermediate-command nil) 305 (setq viper-intermediate-command nil)
306 (cond ((eq new-state 'vi-state) 306 (cond ((eq new-state 'vi-state)
307 (cond ((member viper-current-state '(insert-state replace-state)) 307 (cond ((member viper-current-state '(insert-state replace-state))
@@ -344,9 +344,9 @@
344 (viper-move-marker-locally 344 (viper-move-marker-locally
345 'viper-last-posn-while-in-insert-state (point)) 345 'viper-last-posn-while-in-insert-state (point))
346 (add-hook 'viper-post-command-hooks 346 (add-hook 'viper-post-command-hooks
347 'viper-insert-state-post-command-sentinel t 'local) 347 #'viper-insert-state-post-command-sentinel t 'local)
348 (add-hook 'viper-pre-command-hooks 348 (add-hook 'viper-pre-command-hooks
349 'viper-insert-state-pre-command-sentinel t 'local)) 349 #'viper-insert-state-pre-command-sentinel t 'local))
350 ) ; outermost cond 350 ) ; outermost cond
351 351
352 ;; Nothing needs to be done to switch to emacs mode! Just set some 352 ;; Nothing needs to be done to switch to emacs mode! Just set some
@@ -1074,7 +1074,7 @@ as a Meta key and any number of multiple escapes are allowed."
1074 ;; it is an error. 1074 ;; it is an error.
1075 (progn 1075 (progn
1076 ;; new com is (CHAR . OLDCOM) 1076 ;; new com is (CHAR . OLDCOM)
1077 (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell)) 1077 (if (viper-memq-char char '(?# ?\")) (viper--user-error))
1078 (setq com (cons char com)) 1078 (setq com (cons char com))
1079 (setq cont nil)) 1079 (setq cont nil))
1080 ;; If com is nil we set com as char, and read more. Again, if char is 1080 ;; If com is nil we set com as char, and read more. Again, if char is
@@ -1093,7 +1093,7 @@ as a Meta key and any number of multiple escapes are allowed."
1093 (let ((reg (read-char))) 1093 (let ((reg (read-char)))
1094 (if (viper-valid-register reg) 1094 (if (viper-valid-register reg)
1095 (setq viper-use-register reg) 1095 (setq viper-use-register reg)
1096 (user-error viper-ViperBell)) 1096 (viper--user-error))
1097 (setq char (read-char)))) 1097 (setq char (read-char))))
1098 (t 1098 (t
1099 (setq com char) 1099 (setq com char)
@@ -1115,7 +1115,7 @@ as a Meta key and any number of multiple escapes are allowed."
1115 (viper-regsuffix-command-p char) 1115 (viper-regsuffix-command-p char)
1116 (viper= char ?!) ; bang command 1116 (viper= char ?!) ; bang command
1117 (viper= char ?g) ; the gg command (like G0) 1117 (viper= char ?g) ; the gg command (like G0)
1118 (user-error viper-ViperBell)) 1118 (viper--user-error))
1119 (setq cmd-to-exec-at-end 1119 (setq cmd-to-exec-at-end
1120 (viper-exec-form-in-vi 1120 (viper-exec-form-in-vi
1121 `(key-binding (char-to-string ,char))))) 1121 `(key-binding (char-to-string ,char)))))
@@ -1149,7 +1149,7 @@ as a Meta key and any number of multiple escapes are allowed."
1149 ((equal com '(?= . ?=)) (viper-line (cons value ?=))) 1149 ((equal com '(?= . ?=)) (viper-line (cons value ?=)))
1150 ;; gg acts as G0 1150 ;; gg acts as G0
1151 ((equal (car com) ?g) (viper-goto-line 0)) 1151 ((equal (car com) ?g) (viper-goto-line 0))
1152 (t (user-error viper-ViperBell))))) 1152 (t (viper--user-error)))))
1153 1153
1154 (if cmd-to-exec-at-end 1154 (if cmd-to-exec-at-end
1155 (progn 1155 (progn
@@ -1432,23 +1432,25 @@ as a Meta key and any number of multiple escapes are allowed."
1432 (setq viper-intermediate-command 'viper-exec-buffer-search) 1432 (setq viper-intermediate-command 'viper-exec-buffer-search)
1433 (viper-search viper-s-string viper-s-forward 1)) 1433 (viper-search viper-s-string viper-s-forward 1))
1434 1434
1435(defvar viper-exec-array (make-vector 128 nil)) 1435(defvar viper-exec-array
1436 (let ((a (make-vector 128 nil)))
1436 1437
1437;; Using a dispatch array allows adding functions like buffer search 1438 ;; Using a dispatch array allows adding functions like buffer search
1438;; without affecting other functions. Buffer search can now be bound 1439 ;; without affecting other functions. Buffer search can now be bound
1439;; to any character. 1440 ;; to any character.
1440 1441
1441(aset viper-exec-array ?c 'viper-exec-change) 1442 (aset a ?c 'viper-exec-change)
1442(aset viper-exec-array ?C 'viper-exec-Change) 1443 (aset a ?C 'viper-exec-Change)
1443(aset viper-exec-array ?d 'viper-exec-delete) 1444 (aset a ?d 'viper-exec-delete)
1444(aset viper-exec-array ?D 'viper-exec-Delete) 1445 (aset a ?D 'viper-exec-Delete)
1445(aset viper-exec-array ?y 'viper-exec-yank) 1446 (aset a ?y 'viper-exec-yank)
1446(aset viper-exec-array ?Y 'viper-exec-Yank) 1447 (aset a ?Y 'viper-exec-Yank)
1447(aset viper-exec-array ?r 'viper-exec-dummy) 1448 (aset a ?r 'viper-exec-dummy)
1448(aset viper-exec-array ?! 'viper-exec-bang) 1449 (aset a ?! 'viper-exec-bang)
1449(aset viper-exec-array ?< 'viper-exec-shift) 1450 (aset a ?< 'viper-exec-shift)
1450(aset viper-exec-array ?> 'viper-exec-shift) 1451 (aset a ?> 'viper-exec-shift)
1451(aset viper-exec-array ?= 'viper-exec-equals) 1452 (aset a ?= 'viper-exec-equals)
1453 a))
1452 1454
1453 1455
1454 1456
@@ -1587,7 +1589,7 @@ invokes the command before that, etc."
1587(defun viper-undo-sentinel (beg end length) 1589(defun viper-undo-sentinel (beg end length)
1588 (run-hook-with-args 'viper-undo-functions beg end length)) 1590 (run-hook-with-args 'viper-undo-functions beg end length))
1589 1591
1590(add-hook 'after-change-functions 'viper-undo-sentinel) 1592(add-hook 'after-change-functions #'viper-undo-sentinel)
1591 1593
1592;; Hook used in viper-undo 1594;; Hook used in viper-undo
1593(defun viper-after-change-undo-hook (beg end _len) 1595(defun viper-after-change-undo-hook (beg end _len)
@@ -1597,7 +1599,7 @@ invokes the command before that, etc."
1597 ;; some other hooks may be changing various text properties in 1599 ;; some other hooks may be changing various text properties in
1598 ;; the buffer in response to 'undo'; so remove this hook to avoid 1600 ;; the buffer in response to 'undo'; so remove this hook to avoid
1599 ;; its repeated invocation 1601 ;; its repeated invocation
1600 (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local) 1602 (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local)
1601 )) 1603 ))
1602 1604
1603(defun viper-undo () 1605(defun viper-undo ()
@@ -1608,7 +1610,7 @@ invokes the command before that, etc."
1608 undo-beg-posn undo-end-posn) 1610 undo-beg-posn undo-end-posn)
1609 1611
1610 ;; the viper-after-change-undo-hook removes itself after the 1st invocation 1612 ;; the viper-after-change-undo-hook removes itself after the 1st invocation
1611 (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local) 1613 (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local)
1612 1614
1613 (undo-start) 1615 (undo-start)
1614 (undo-more 2) 1616 (undo-more 2)
@@ -1880,8 +1882,8 @@ Undo previous insertion and inserts new."
1880;;; Minibuffer business 1882;;; Minibuffer business
1881 1883
1882(defsubst viper-set-minibuffer-style () 1884(defsubst viper-set-minibuffer-style ()
1883 (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) 1885 (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel)
1884 (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook)) 1886 (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook))
1885 1887
1886 1888
1887(defun viper-minibuffer-setup-sentinel () 1889(defun viper-minibuffer-setup-sentinel ()
@@ -2227,22 +2229,22 @@ problems."
2227 viper-sitting-in-replace t 2229 viper-sitting-in-replace t
2228 viper-replace-chars-to-delete 0) 2230 viper-replace-chars-to-delete 0)
2229 (add-hook 2231 (add-hook
2230 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local) 2232 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local)
2231 (add-hook 2233 (add-hook
2232 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local) 2234 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local)
2233 ;; this will get added repeatedly, but no harm 2235 ;; this will get added repeatedly, but no harm
2234 (add-hook 'after-change-functions 'viper-after-change-sentinel t) 2236 (add-hook 'after-change-functions #'viper-after-change-sentinel t)
2235 (add-hook 'before-change-functions 'viper-before-change-sentinel t) 2237 (add-hook 'before-change-functions #'viper-before-change-sentinel t)
2236 (viper-move-marker-locally 2238 (viper-move-marker-locally
2237 'viper-last-posn-in-replace-region (viper-replace-start)) 2239 'viper-last-posn-in-replace-region (viper-replace-start))
2238 (add-hook 2240 (add-hook
2239 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 2241 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
2240 t 'local) 2242 t 'local)
2241 (add-hook 2243 (add-hook
2242 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) 2244 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
2243 ;; guard against a smarty who switched from R-replace to normal replace 2245 ;; guard against a smarty who switched from R-replace to normal replace
2244 (remove-hook 2246 (remove-hook
2245 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) 2247 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
2246 (if overwrite-mode (overwrite-mode -1)) 2248 (if overwrite-mode (overwrite-mode -1))
2247 ) 2249 )
2248 2250
@@ -2316,13 +2318,13 @@ problems."
2316;; Don't delete anything if current point is past the end of the overlay. 2318;; Don't delete anything if current point is past the end of the overlay.
2317(defun viper-finish-change () 2319(defun viper-finish-change ()
2318 (remove-hook 2320 (remove-hook
2319 'viper-after-change-functions 'viper-replace-mode-spy-after 'local) 2321 'viper-after-change-functions #'viper-replace-mode-spy-after 'local)
2320 (remove-hook 2322 (remove-hook
2321 'viper-before-change-functions 'viper-replace-mode-spy-before 'local) 2323 'viper-before-change-functions #'viper-replace-mode-spy-before 'local)
2322 (remove-hook 2324 (remove-hook
2323 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) 2325 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
2324 (remove-hook 2326 (remove-hook
2325 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) 2327 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
2326 (viper-restore-cursor-color 'after-replace-mode) 2328 (viper-restore-cursor-color 'after-replace-mode)
2327 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it 2329 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it
2328 (save-excursion 2330 (save-excursion
@@ -2352,21 +2354,21 @@ problems."
2352 2354
2353(defun viper-finish-R-mode () 2355(defun viper-finish-R-mode ()
2354 (remove-hook 2356 (remove-hook
2355 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) 2357 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
2356 (remove-hook 2358 (remove-hook
2357 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) 2359 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
2358 (viper-downgrade-to-insert)) 2360 (viper-downgrade-to-insert))
2359 2361
2360(defun viper-start-R-mode () 2362(defun viper-start-R-mode ()
2361 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number 2363 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
2362 (overwrite-mode 1) 2364 (overwrite-mode 1)
2363 (add-hook 2365 (add-hook
2364 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local) 2366 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local)
2365 (add-hook 2367 (add-hook
2366 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) 2368 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local)
2367 ;; guard against a smarty who switched from R-replace to normal replace 2369 ;; guard against a smarty who switched from R-replace to normal replace
2368 (remove-hook 2370 (remove-hook
2369 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) 2371 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local)
2370 ) 2372 )
2371 2373
2372 2374
@@ -2541,9 +2543,9 @@ On reaching end of line, stop and signal error."
2541 ;; the forward motion before the 'viper-execute-com', but, of 2543 ;; the forward motion before the 'viper-execute-com', but, of
2542 ;; course, 'dl' doesn't work on an empty line, so we have to 2544 ;; course, 'dl' doesn't work on an empty line, so we have to
2543 ;; catch that condition before 'viper-execute-com' 2545 ;; catch that condition before 'viper-execute-com'
2544 (if (and (eolp) (bolp)) (user-error viper-ViperBell) (forward-char val)) 2546 (if (and (eolp) (bolp)) (viper--user-error) (forward-char val))
2545 (if com (viper-execute-com 'viper-forward-char val com)) 2547 (if com (viper-execute-com 'viper-forward-char val com))
2546 (if (eolp) (progn (backward-char 1) (user-error viper-ViperBell)))) 2548 (if (eolp) (progn (backward-char 1) (viper--user-error))))
2547 (forward-char val) 2549 (forward-char val)
2548 (if com (viper-execute-com 'viper-forward-char val com))))) 2550 (if com (viper-execute-com 'viper-forward-char val com)))))
2549 2551
@@ -2557,7 +2559,7 @@ On reaching beginning of line, stop and signal error."
2557 (if com (viper-move-marker-locally 'viper-com-point (point))) 2559 (if com (viper-move-marker-locally 'viper-com-point (point)))
2558 (if viper-ex-style-motion 2560 (if viper-ex-style-motion
2559 (progn 2561 (progn
2560 (if (bolp) (user-error viper-ViperBell) (backward-char val)) 2562 (if (bolp) (viper--user-error) (backward-char val))
2561 (if com (viper-execute-com 'viper-backward-char val com))) 2563 (if com (viper-execute-com 'viper-backward-char val com)))
2562 (backward-char val) 2564 (backward-char val)
2563 (if com (viper-execute-com 'viper-backward-char val com))))) 2565 (if com (viper-execute-com 'viper-backward-char val com)))))
@@ -2874,7 +2876,7 @@ On reaching beginning of line, stop and signal error."
2874 (if com (viper-execute-com 'viper-goto-col val com)) 2876 (if com (viper-execute-com 'viper-goto-col val com))
2875 (save-excursion 2877 (save-excursion
2876 (end-of-line) 2878 (end-of-line)
2877 (if (> val (current-column)) (user-error viper-ViperBell))) 2879 (if (> val (current-column)) (viper--user-error)))
2878 )) 2880 ))
2879 2881
2880 2882
@@ -3001,7 +3003,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
3001;; If FORWARD then search is forward, otherwise backward. OFFSET is used to 3003;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
3002;; adjust point after search. 3004;; adjust point after search.
3003(defun viper-find-char (arg char forward offset) 3005(defun viper-find-char (arg char forward offset)
3004 (or (char-or-string-p char) (user-error viper-ViperBell)) 3006 (or (char-or-string-p char) (viper--user-error))
3005 (let ((arg (if forward arg (- arg))) 3007 (let ((arg (if forward arg (- arg)))
3006 (cmd (if (eq viper-intermediate-command 'viper-repeat) 3008 (cmd (if (eq viper-intermediate-command 'viper-repeat)
3007 (nth 5 viper-d-com) 3009 (nth 5 viper-d-com)
@@ -3335,7 +3337,7 @@ controlled by the sign of prefix numeric value."
3335 (if com (viper-move-marker-locally 'viper-com-point (point))) 3337 (if com (viper-move-marker-locally 'viper-com-point (point)))
3336 (backward-sexp 1) 3338 (backward-sexp 1)
3337 (if com (viper-execute-com 'viper-paren-match nil com))) 3339 (if com (viper-execute-com 'viper-paren-match nil com)))
3338 (t (user-error viper-ViperBell)))))) 3340 (t (viper--user-error))))))
3339 3341
3340(defun viper-toggle-parse-sexp-ignore-comments () 3342(defun viper-toggle-parse-sexp-ignore-comments ()
3341 (interactive) 3343 (interactive)
@@ -3906,7 +3908,7 @@ Null string will repeat previous search."
3906 (let ((reg viper-use-register)) 3908 (let ((reg viper-use-register))
3907 (setq viper-use-register nil) 3909 (setq viper-use-register nil)
3908 (error viper-EmptyRegister reg)) 3910 (error viper-EmptyRegister reg))
3909 (user-error viper-ViperBell))) 3911 (viper--user-error)))
3910 (setq viper-use-register nil) 3912 (setq viper-use-register nil)
3911 (if (viper-end-with-a-newline-p text) 3913 (if (viper-end-with-a-newline-p text)
3912 (progn 3914 (progn
@@ -3956,7 +3958,7 @@ Null string will repeat previous search."
3956 (let ((reg viper-use-register)) 3958 (let ((reg viper-use-register))
3957 (setq viper-use-register nil) 3959 (setq viper-use-register nil)
3958 (error viper-EmptyRegister reg)) 3960 (error viper-EmptyRegister reg))
3959 (user-error viper-ViperBell))) 3961 (viper--user-error)))
3960 (setq viper-use-register nil) 3962 (setq viper-use-register nil)
3961 (if (viper-end-with-a-newline-p text) (beginning-of-line)) 3963 (if (viper-end-with-a-newline-p text) (beginning-of-line))
3962 (viper-set-destructive-command 3964 (viper-set-destructive-command
@@ -4001,7 +4003,7 @@ Null string will repeat previous search."
4001 (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4003 (> val (viper-chars-in-region (point) (viper-line-pos 'end))))
4002 (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4004 (setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
4003 (if (and viper-ex-style-motion (eolp)) 4005 (if (and viper-ex-style-motion (eolp))
4004 (if (bolp) (user-error viper-ViperBell) (setq val 0))) ; not bol---simply back 1 ch 4006 (if (bolp) (viper--user-error) (setq val 0))) ; not bol---simply back 1 ch
4005 (save-excursion 4007 (save-excursion
4006 (viper-forward-char-carefully val) 4008 (viper-forward-char-carefully val)
4007 (setq end-del-pos (point))) 4009 (setq end-del-pos (point)))
@@ -4271,7 +4273,7 @@ and regexp replace."
4271 ((viper= char ?,) (viper-cycle-through-mark-ring)) 4273 ((viper= char ?,) (viper-cycle-through-mark-ring))
4272 ((viper= char ?^) (push-mark viper-saved-mark t t)) 4274 ((viper= char ?^) (push-mark viper-saved-mark t t))
4273 ((viper= char ?D) (mark-defun)) 4275 ((viper= char ?D) (mark-defun))
4274 (t (user-error viper-ViperBell)) 4276 (t (viper--user-error))
4275 ))) 4277 )))
4276 4278
4277;; Algorithm: If first invocation of this command save mark on ring, goto 4279;; Algorithm: If first invocation of this command save mark on ring, goto
@@ -4370,7 +4372,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
4370 (switch-to-buffer buff) 4372 (switch-to-buffer buff)
4371 (goto-char viper-com-point) 4373 (goto-char viper-com-point)
4372 (viper-change-state-to-vi) 4374 (viper-change-state-to-vi)
4373 (user-error viper-ViperBell))))) 4375 (viper--user-error)))))
4374 ((and (not skip-white) (viper= char ?`)) 4376 ((and (not skip-white) (viper= char ?`))
4375 (if com (viper-move-marker-locally 'viper-com-point (point))) 4377 (if com (viper-move-marker-locally 'viper-com-point (point)))
4376 (if (and (viper-same-line (point) viper-last-jump) 4378 (if (and (viper-same-line (point) viper-last-jump)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 26bca686cb3..7aa3333f25c 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1239,7 +1239,7 @@ reversed."
1239 (read-string "[Hit return to confirm] ") 1239 (read-string "[Hit return to confirm] ")
1240 (quit 1240 (quit
1241 (save-excursion (kill-buffer " *delete text*")) 1241 (save-excursion (kill-buffer " *delete text*"))
1242 (user-error viper-ViperBell))) 1242 (viper--user-error)))
1243 (save-excursion (kill-buffer " *delete text*"))) 1243 (save-excursion (kill-buffer " *delete text*")))
1244 (if ex-buffer 1244 (if ex-buffer
1245 (cond ((viper-valid-register ex-buffer '(Letter)) 1245 (cond ((viper-valid-register ex-buffer '(Letter))
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 1d7bb1580ce..2af94979278 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -64,6 +64,8 @@
64(define-obsolete-function-alias 'viper-iconify 64(define-obsolete-function-alias 'viper-iconify
65 'iconify-or-deiconify-frame "27.1") 65 'iconify-or-deiconify-frame "27.1")
66 66
67(defun viper--user-error () (user-error "Viper bell"))
68(defun viper--user-error () (user-error "Viper bell"))
67 69
68;; CHAR is supposed to be a char or an integer (positive or negative) 70;; CHAR is supposed to be a char or an integer (positive or negative)
69;; LIST is a list of chars, nil, and negative numbers 71;; LIST is a list of chars, nil, and negative numbers
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 53a59207839..bdce91f221f 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -536,17 +536,17 @@ keybindings will not do anything useful."
536 ((when (boundp 'erc-track-when-inactive) 536 ((when (boundp 'erc-track-when-inactive)
537 (if erc-track-when-inactive 537 (if erc-track-when-inactive
538 (progn 538 (progn
539 (add-hook 'window-configuration-change-hook 'erc-user-is-active) 539 (add-hook 'window-configuration-change-hook #'erc-user-is-active)
540 (add-hook 'erc-send-completed-hook 'erc-user-is-active) 540 (add-hook 'erc-send-completed-hook #'erc-user-is-active)
541 (add-hook 'erc-server-001-functions 'erc-user-is-active)) 541 (add-hook 'erc-server-001-functions #'erc-user-is-active))
542 (erc-track-add-to-mode-line erc-track-position-in-mode-line) 542 (erc-track-add-to-mode-line erc-track-position-in-mode-line)
543 (erc-update-mode-line) 543 (erc-update-mode-line)
544 (add-hook 'window-configuration-change-hook 544 (add-hook 'window-configuration-change-hook
545 'erc-window-configuration-change) 545 #'erc-window-configuration-change)
546 (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) 546 (add-hook 'erc-insert-post-hook #'erc-track-modified-channels)
547 (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) 547 (add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
548 ;; enable the tracking keybindings 548 ;; enable the tracking keybindings
549 (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) 549 (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
550 (erc-track-minor-mode-maybe))) 550 (erc-track-minor-mode-maybe)))
551 ;; Disable: 551 ;; Disable:
552 ((when (boundp 'erc-track-when-inactive) 552 ((when (boundp 'erc-track-when-inactive)
@@ -554,14 +554,15 @@ keybindings will not do anything useful."
554 (if erc-track-when-inactive 554 (if erc-track-when-inactive
555 (progn 555 (progn
556 (remove-hook 'window-configuration-change-hook 556 (remove-hook 'window-configuration-change-hook
557 'erc-user-is-active) 557 #'erc-user-is-active)
558 (remove-hook 'erc-send-completed-hook 'erc-user-is-active) 558 (remove-hook 'erc-send-completed-hook #'erc-user-is-active)
559 (remove-hook 'erc-server-001-functions 'erc-user-is-active) 559 (remove-hook 'erc-server-001-functions #'erc-user-is-active)
560 (remove-hook 'erc-timer-hook 'erc-user-is-active)) 560 ;; FIXME: Never added!?
561 (remove-hook 'erc-timer-hook #'erc-user-is-active))
561 (remove-hook 'window-configuration-change-hook 562 (remove-hook 'window-configuration-change-hook
562 'erc-window-configuration-change) 563 #'erc-window-configuration-change)
563 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) 564 (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update)
564 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) 565 (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels))
565 ;; disable the tracking keybindings 566 ;; disable the tracking keybindings
566 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) 567 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
567 (when erc-track-minor-mode 568 (when erc-track-minor-mode
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f5c9decc3a2..0b0cc044e91 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -5453,7 +5453,7 @@ This returns non-nil only if we actually send anything."
5453 ;; obsolete, and when it's finally removed, this binding should 5453 ;; obsolete, and when it's finally removed, this binding should
5454 ;; also be removed. 5454 ;; also be removed.
5455 (with-suppressed-warnings ((lexical str)) 5455 (with-suppressed-warnings ((lexical str))
5456 (defvar str)) 5456 (defvar str)) ;FIXME: Obey the "erc-" prefix convention.
5457 (let ((str input) 5457 (let ((str input)
5458 (erc-insert-this t) 5458 (erc-insert-this t)
5459 (erc-send-this t) 5459 (erc-send-this t)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index fe8eb35d366..96e95365f5f 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -306,8 +306,7 @@ Prepend remote identification of `default-directory', if any."
306 (setq m (cdr m)))) 306 (setq m (cdr m))))
307 l) 307 l)
308(define-obsolete-function-alias 308(define-obsolete-function-alias
309 'eshell-uniqify-list 309 'eshell-uniqify-list #'eshell-uniquify-list "27.1")
310 'eshell-uniquify-list "27.1")
311 310
312(defun eshell-stringify (object) 311(defun eshell-stringify (object)
313 "Convert OBJECT into a string value." 312 "Convert OBJECT into a string value."
@@ -326,11 +325,11 @@ Prepend remote identification of `default-directory', if any."
326 325
327(defsubst eshell-stringify-list (args) 326(defsubst eshell-stringify-list (args)
328 "Convert each element of ARGS into a string value." 327 "Convert each element of ARGS into a string value."
329 (mapcar 'eshell-stringify args)) 328 (mapcar #'eshell-stringify args))
330 329
331(defsubst eshell-flatten-and-stringify (&rest args) 330(defsubst eshell-flatten-and-stringify (&rest args)
332 "Flatten and stringify all of the ARGS into a single string." 331 "Flatten and stringify all of the ARGS into a single string."
333 (mapconcat 'eshell-stringify (flatten-tree args) " ")) 332 (mapconcat #'eshell-stringify (flatten-tree args) " "))
334 333
335(defsubst eshell-directory-files (regexp &optional directory) 334(defsubst eshell-directory-files (regexp &optional directory)
336 "Return a list of files in the given DIRECTORY matching REGEXP." 335 "Return a list of files in the given DIRECTORY matching REGEXP."
@@ -526,7 +525,7 @@ Unless optional argument INPLACE is non-nil, return a new string."
526 525
527(defsubst eshell-copy-environment () 526(defsubst eshell-copy-environment ()
528 "Return an unrelated copy of `process-environment'." 527 "Return an unrelated copy of `process-environment'."
529 (mapcar 'concat process-environment)) 528 (mapcar #'concat process-environment))
530 529
531(defun eshell-subgroups (groupsym) 530(defun eshell-subgroups (groupsym)
532 "Return all of the subgroups of GROUPSYM." 531 "Return all of the subgroups of GROUPSYM."
diff --git a/lisp/follow.el b/lisp/follow.el
index acc2b26c550..e570fffdf58 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -117,7 +117,7 @@
117;; `follow-mode'. 117;; `follow-mode'.
118;; 118;;
119;; Example: 119;; Example:
120;; (add-hook 'follow-mode-hook 'my-follow-mode-hook) 120;; (add-hook 'follow-mode-hook #'my-follow-mode-hook)
121;; 121;;
122;; (defun my-follow-mode-hook () 122;; (defun my-follow-mode-hook ()
123;; (define-key follow-mode-map "\C-ca" 'your-favorite-function) 123;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
@@ -307,8 +307,8 @@ are \" Fw\", or simply \"\"."
307 :group 'follow 307 :group 'follow
308 :set (lambda (symbol value) 308 :set (lambda (symbol value)
309 (if value 309 (if value
310 (add-hook 'find-file-hook 'follow-find-file-hook t) 310 (add-hook 'find-file-hook #'follow-find-file-hook t)
311 (remove-hook 'find-file-hook 'follow-find-file-hook)) 311 (remove-hook 'find-file-hook #'follow-find-file-hook))
312 (set-default symbol value))) 312 (set-default symbol value)))
313 313
314(defcustom follow-hide-ghost-cursors t ; Maybe this should be nil. 314(defcustom follow-hide-ghost-cursors t ; Maybe this should be nil.
@@ -370,7 +370,7 @@ This is typically set by explicit scrolling commands.")
370(defsubst follow-debug-message (&rest args) 370(defsubst follow-debug-message (&rest args)
371 "Like `message', but only active when `follow-debug' is non-nil." 371 "Like `message', but only active when `follow-debug' is non-nil."
372 (if (and (boundp 'follow-debug) follow-debug) 372 (if (and (boundp 'follow-debug) follow-debug)
373 (apply 'message args))) 373 (apply #'message args)))
374 374
375;;; Cache 375;;; Cache
376 376
@@ -428,27 +428,28 @@ Keys specific to Follow mode:
428 :keymap follow-mode-map 428 :keymap follow-mode-map
429 (if follow-mode 429 (if follow-mode
430 (progn 430 (progn
431 (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t) 431 (add-hook 'compilation-filter-hook
432 (add-function :before pre-redisplay-function 'follow-pre-redisplay-function) 432 #'follow-align-compilation-windows t t)
433 (add-hook 'window-size-change-functions 'follow-window-size-change t) 433 (add-function :before pre-redisplay-function #'follow-pre-redisplay-function)
434 (add-hook 'after-change-functions 'follow-after-change nil t) 434 (add-hook 'window-size-change-functions #'follow-window-size-change t)
435 (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t) 435 (add-hook 'after-change-functions #'follow-after-change nil t)
436 (add-hook 'replace-update-post-hook 'follow-post-command-hook nil t) 436 (add-hook 'isearch-update-post-hook #'follow-post-command-hook nil t)
437 (add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t) 437 (add-hook 'replace-update-post-hook #'follow-post-command-hook nil t)
438 (add-hook 'ispell-update-post-hook #'follow-post-command-hook nil t)
438 439
439 (when isearch-lazy-highlight 440 (when isearch-lazy-highlight
440 (setq-local isearch-lazy-highlight 'all-windows)) 441 (setq-local isearch-lazy-highlight 'all-windows))
441 (when follow-hide-ghost-cursors 442 (when follow-hide-ghost-cursors
442 (setq-local cursor-in-non-selected-windows nil)) 443 (setq-local cursor-in-non-selected-windows nil))
443 444
444 (setq window-group-start-function 'follow-window-start) 445 (setq window-group-start-function #'follow-window-start)
445 (setq window-group-end-function 'follow-window-end) 446 (setq window-group-end-function #'follow-window-end)
446 (setq set-window-group-start-function 'follow-set-window-start) 447 (setq set-window-group-start-function #'follow-set-window-start)
447 (setq recenter-window-group-function 'follow-recenter) 448 (setq recenter-window-group-function #'follow-recenter)
448 (setq pos-visible-in-window-group-p-function 449 (setq pos-visible-in-window-group-p-function
449 'follow-pos-visible-in-window-p) 450 #'follow-pos-visible-in-window-p)
450 (setq selected-window-group-function 'follow-all-followers) 451 (setq selected-window-group-function #'follow-all-followers)
451 (setq move-to-window-group-line-function 'follow-move-to-window-line)) 452 (setq move-to-window-group-line-function #'follow-move-to-window-line))
452 453
453 ;; Remove globally-installed hook functions only if there is no 454 ;; Remove globally-installed hook functions only if there is no
454 ;; other Follow mode buffer. 455 ;; other Follow mode buffer.
@@ -458,8 +459,8 @@ Keys specific to Follow mode:
458 (setq following (buffer-local-value 'follow-mode (car buffers)) 459 (setq following (buffer-local-value 'follow-mode (car buffers))
459 buffers (cdr buffers))) 460 buffers (cdr buffers)))
460 (unless following 461 (unless following
461 (remove-function pre-redisplay-function 'follow-pre-redisplay-function) 462 (remove-function pre-redisplay-function #'follow-pre-redisplay-function)
462 (remove-hook 'window-size-change-functions 'follow-window-size-change))) 463 (remove-hook 'window-size-change-functions #'follow-window-size-change)))
463 464
464 (kill-local-variable 'move-to-window-group-line-function) 465 (kill-local-variable 'move-to-window-group-line-function)
465 (kill-local-variable 'selected-window-group-function) 466 (kill-local-variable 'selected-window-group-function)
@@ -471,11 +472,11 @@ Keys specific to Follow mode:
471 472
472 (kill-local-variable 'cursor-in-non-selected-windows) 473 (kill-local-variable 'cursor-in-non-selected-windows)
473 474
474 (remove-hook 'ispell-update-post-hook 'follow-post-command-hook t) 475 (remove-hook 'ispell-update-post-hook #'follow-post-command-hook t)
475 (remove-hook 'replace-update-post-hook 'follow-post-command-hook t) 476 (remove-hook 'replace-update-post-hook #'follow-post-command-hook t)
476 (remove-hook 'isearch-update-post-hook 'follow-post-command-hook t) 477 (remove-hook 'isearch-update-post-hook #'follow-post-command-hook t)
477 (remove-hook 'after-change-functions 'follow-after-change t) 478 (remove-hook 'after-change-functions #'follow-after-change t)
478 (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t))) 479 (remove-hook 'compilation-filter-hook #'follow-align-compilation-windows t)))
479 480
480(defun follow-find-file-hook () 481(defun follow-find-file-hook ()
481 "Find-file hook for Follow mode. See the variable `follow-auto'." 482 "Find-file hook for Follow mode. See the variable `follow-auto'."
@@ -1051,16 +1052,16 @@ returned by `follow-windows-start-end'."
1051(defun follow-select-if-visible (dest win-start-end) 1052(defun follow-select-if-visible (dest win-start-end)
1052 "Select and return a window, if DEST is visible in it. 1053 "Select and return a window, if DEST is visible in it.
1053Return the selected window." 1054Return the selected window."
1054 (let (win wse) 1055 (let (win)
1055 (while (and (not win) win-start-end) 1056 (while (and (not win) win-start-end)
1056 ;; Don't select a window that was just moved. This makes it 1057 ;; Don't select a window that was just moved. This makes it
1057 ;; possible to later select the last window after a 1058 ;; possible to later select the last window after a
1058 ;; `end-of-buffer' command. 1059 ;; `end-of-buffer' command.
1059 (setq wse (car win-start-end)) 1060 (let ((wse (car win-start-end)))
1060 (when (follow-pos-visible dest (car wse) win-start-end) 1061 (when (follow-pos-visible dest (car wse) win-start-end)
1061 (setq win (car wse)) 1062 (setq win (car wse))
1062 (select-window win)) 1063 (select-window win))
1063 (setq win-start-end (cdr win-start-end))) 1064 (setq win-start-end (cdr win-start-end))))
1064 win)) 1065 win))
1065 1066
1066;; Lets select a window showing the end. Make sure we only select it if 1067;; Lets select a window showing the end. Make sure we only select it if
@@ -1217,29 +1218,29 @@ should be a member of WINDOWS, starts at position START."
1217 (setq win (or win (selected-window))) 1218 (setq win (or win (selected-window)))
1218 (setq start (or start (window-start win))) 1219 (setq start (or start (window-start win)))
1219 (save-excursion 1220 (save-excursion
1220 (let (done win-start res opoint) 1221 ;; Always calculate what happens when no line is displayed in the first
1221 ;; Always calculate what happens when no line is displayed in the first 1222 ;; window. (The `previous' res is needed below!)
1222 ;; window. (The `previous' res is needed below!) 1223 (goto-char guess)
1223 (goto-char guess) 1224 (vertical-motion 0 (car windows))
1224 (vertical-motion 0 (car windows)) 1225 (let ((res (point))
1225 (setq res (point)) 1226 done)
1226 (while (not done) 1227 (while (not done)
1227 (setq opoint (point)) 1228 (let ((opoint (point)))
1228 (if (not (= (vertical-motion -1 (car windows)) -1)) 1229 (if (not (= (vertical-motion -1 (car windows)) -1))
1229 ;; Hit roof! 1230 ;; Hit roof!
1230 (setq done t res (point-min)) 1231 (setq done t res (point-min))
1231 (setq win-start (follow-calc-win-start windows (point) win)) 1232 (let ((win-start (follow-calc-win-start windows (point) win)))
1232 (cond ((>= (point) opoint) 1233 (cond ((>= (point) opoint)
1233 ;; In some pathological cases, vertical-motion may 1234 ;; In some pathological cases, vertical-motion may
1234 ;; return -1 even though point has not decreased. In 1235 ;; return -1 even though point has not decreased. In
1235 ;; that case, avoid looping forever. 1236 ;; that case, avoid looping forever.
1236 (setq done t res (point))) 1237 (setq done t res (point)))
1237 ((= win-start start) ; Perfect match, use this value 1238 ((= win-start start) ; Perfect match, use this value
1238 (setq done t res (point))) 1239 (setq done t res (point)))
1239 ((< win-start start) ; Walked to far, use previous result 1240 ((< win-start start) ; Walked to far, use previous result
1240 (setq done t)) 1241 (setq done t))
1241 (t ; Store result for next iteration 1242 (t ; Store result for next iteration
1242 (setq res (point)))))) 1243 (setq res (point))))))))
1243 res))) 1244 res)))
1244 1245
1245;;; Avoid tail recenter 1246;;; Avoid tail recenter
@@ -1316,6 +1317,8 @@ follow-mode is not necessarily enabled in this buffer.")
1316 ;; Work in the selected window, not in the current buffer. 1317 ;; Work in the selected window, not in the current buffer.
1317 (with-current-buffer (window-buffer win) 1318 (with-current-buffer (window-buffer win)
1318 (unless (and (symbolp this-command) 1319 (unless (and (symbolp this-command)
1320 ;; FIXME: Why not compare buffer-modified-tick and
1321 ;; selected-window to their old value, instead?
1319 (get this-command 'follow-mode-use-cache)) 1322 (get this-command 'follow-mode-use-cache))
1320 (setq follow-windows-start-end-cache nil)) 1323 (setq follow-windows-start-end-cache nil))
1321 (follow-adjust-window win))))) 1324 (follow-adjust-window win)))))
@@ -1323,7 +1326,7 @@ follow-mode is not necessarily enabled in this buffer.")
1323;; NOTE: to debug follow-mode with edebug, it is helpful to add 1326;; NOTE: to debug follow-mode with edebug, it is helpful to add
1324;; `follow-post-command-hook' to `post-command-hook' temporarily. Do 1327;; `follow-post-command-hook' to `post-command-hook' temporarily. Do
1325;; this locally to the target buffer with, say,: 1328;; this locally to the target buffer with, say,:
1326;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t) 1329;; M-: (add-hook 'post-command-hook #'follow-post-command-hook t t)
1327;; . 1330;; .
1328 1331
1329(defun follow-adjust-window (win) 1332(defun follow-adjust-window (win)
@@ -1511,15 +1514,12 @@ follow-mode is not necessarily enabled in this buffer.")
1511 "Make a highlighted region stretching multiple windows look good." 1514 "Make a highlighted region stretching multiple windows look good."
1512 (let* ((all (follow-split-followers windows win)) 1515 (let* ((all (follow-split-followers windows win))
1513 (pred (car all)) 1516 (pred (car all))
1514 (succ (cdr all)) 1517 (succ (cdr all)))
1515 data) 1518 (dolist (w pred)
1516 (while pred 1519 (let ((data (assq w win-start-end)))
1517 (setq data (assq (car pred) win-start-end)) 1520 (set-window-point w (max (nth 1 data) (- (nth 2 data) 1)))))
1518 (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1))) 1521 (dolist (w succ)
1519 (setq pred (cdr pred))) 1522 (set-window-point w (nth 1 (assq w win-start-end))))))
1520 (while succ
1521 (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
1522 (setq succ (cdr succ)))))
1523 1523
1524;;; Scroll bar 1524;;; Scroll bar
1525 1525
@@ -1616,7 +1616,7 @@ follow-mode is not necessarily enabled in this buffer.")
1616 (select-window picked-window 'norecord))) 1616 (select-window picked-window 'norecord)))
1617 (select-frame orig-frame))))) 1617 (select-frame orig-frame)))))
1618 1618
1619(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t) 1619(add-hook 'window-scroll-functions #'follow-avoid-tail-recenter t)
1620 1620
1621;;; Low level window start and end. 1621;;; Low level window start and end.
1622 1622
@@ -1690,9 +1690,8 @@ of the actual window containing it. The remaining elements are
1690omitted if the character after POS is fully visible; otherwise, RTOP 1690omitted if the character after POS is fully visible; otherwise, RTOP
1691and RBOT are the number of pixels off-window at the top and bottom of 1691and RBOT are the number of pixels off-window at the top and bottom of
1692the screen line (\"row\") containing POS, ROWH is the visible height 1692the screen line (\"row\") containing POS, ROWH is the visible height
1693of that row, and VPOS is the row number \(zero-based)." 1693of that row, and VPOS is the row number (zero-based)."
1694 (let* ((windows (follow-all-followers window)) 1694 (let* ((windows (follow-all-followers window)))
1695 (last (car (last windows))))
1696 (when follow-start-end-invalid 1695 (when follow-start-end-invalid
1697 (follow-redisplay windows (car windows))) 1696 (follow-redisplay windows (car windows)))
1698 (let* ((cache (follow-windows-start-end windows)) 1697 (let* ((cache (follow-windows-start-end windows))
@@ -1703,10 +1702,9 @@ of that row, and VPOS is the row number \(zero-based)."
1703 last-elt 1702 last-elt
1704 (setq our-pos (or pos (point))) 1703 (setq our-pos (or pos (point)))
1705 (catch 'element 1704 (catch 'element
1706 (while cache 1705 (dolist (ce cache)
1707 (when (< our-pos (nth 2 (car cache))) 1706 (when (< our-pos (nth 2 ce))
1708 (throw 'element (car cache))) 1707 (throw 'element ce)))
1709 (setq cache (cdr cache)))
1710 last-elt))) 1708 last-elt)))
1711 (pos-visible-in-window-p our-pos (car pertinent-elt) partially)))) 1709 (pos-visible-in-window-p our-pos (car pertinent-elt) partially))))
1712 1710
@@ -1720,7 +1718,7 @@ zero means top of the first window in the group, negative means
1720 (start-end (follow-windows-start-end windows)) 1718 (start-end (follow-windows-start-end windows))
1721 (rev-start-end (reverse start-end)) 1719 (rev-start-end (reverse start-end))
1722 (lines 0) 1720 (lines 0)
1723 middle-window elt count) 1721 elt count)
1724 (select-window 1722 (select-window
1725 (cond 1723 (cond
1726 ((null arg) 1724 ((null arg)
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 4455c594286..e290a2727d5 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,4 +1,4 @@
1;;; format-spec.el --- functions for formatting arbitrary formatting strings 1;;; format-spec.el --- functions for formatting arbitrary formatting strings -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1999-2019 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2019 Free Software Foundation, Inc.
4 4
diff --git a/lisp/frame.el b/lisp/frame.el
index 9402c15a56b..87bf058f7fb 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -26,6 +26,7 @@
26 26
27;;; Code: 27;;; Code:
28(eval-when-compile (require 'cl-lib)) 28(eval-when-compile (require 'cl-lib))
29(eval-when-compile (require 'subr-x)) ;For string-trim-right
29 30
30(cl-defgeneric frame-creation-function (params) 31(cl-defgeneric frame-creation-function (params)
31 "Method for window-system dependent functions to create a new frame. 32 "Method for window-system dependent functions to create a new frame.
@@ -2501,14 +2502,34 @@ command starts, by installing a pre-command hook."
2501 (when (and (> blink-cursor-blinks 0) 2502 (when (and (> blink-cursor-blinks 0)
2502 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) 2503 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
2503 (blink-cursor-suspend) 2504 (blink-cursor-suspend)
2504 (add-hook 'post-command-hook 'blink-cursor-check))) 2505 (add-hook 'post-command-hook #'blink-cursor-check))
2506 ;; FIXME: Under TTYs, apparently redisplay only obeys internal-show-cursor
2507 ;; when there is something else to update on the screen. This is arguably
2508 ;; a bug, but in the meantime we can circumvent it here by causing an
2509 ;; artificial update which thus "forces" a cursor update.
2510 (when (null window-system)
2511 (let* ((message-log-max nil)
2512 (msg (current-message))
2513 ;; Construct a dummy temp message different from the current one.
2514 ;; This message usually flashes by too quickly to be visible, but
2515 ;; occasionally it can be noticed, so make it "inconspicuous".
2516 ;; Not too "inconspicuous", tho: just adding or removing a SPC at the
2517 ;; end doesn't cause an update, for example.
2518 (dummymsg (concat (if (> (length msg) 40)
2519 (let ((msg (string-trim-right msg)))
2520 (if (> (length msg) 2)
2521 (substring msg 0 -2)
2522 msg))
2523 msg) "-")))
2524 (message "%s" dummymsg)
2525 (if msg (message "%s" msg) (message nil)))))
2505 2526
2506(defun blink-cursor-end () 2527(defun blink-cursor-end ()
2507 "Stop cursor blinking. 2528 "Stop cursor blinking.
2508This is installed as a pre-command hook by `blink-cursor-start'. 2529This is installed as a pre-command hook by `blink-cursor-start'.
2509When run, it cancels the timer `blink-cursor-timer' and removes 2530When run, it cancels the timer `blink-cursor-timer' and removes
2510itself as a pre-command hook." 2531itself as a pre-command hook."
2511 (remove-hook 'pre-command-hook 'blink-cursor-end) 2532 (remove-hook 'pre-command-hook #'blink-cursor-end)
2512 (internal-show-cursor nil t) 2533 (internal-show-cursor nil t)
2513 (when blink-cursor-timer 2534 (when blink-cursor-timer
2514 (cancel-timer blink-cursor-timer) 2535 (cancel-timer blink-cursor-timer)
@@ -2527,15 +2548,7 @@ frame receives focus."
2527(defun blink-cursor--should-blink () 2548(defun blink-cursor--should-blink ()
2528 "Determine whether we should be blinking. 2549 "Determine whether we should be blinking.
2529Returns whether we have any focused non-TTY frame." 2550Returns whether we have any focused non-TTY frame."
2530 (and blink-cursor-mode 2551 blink-cursor-mode)
2531 (let ((frame-list (frame-list))
2532 (any-graphical-focused nil))
2533 (while frame-list
2534 (let ((frame (pop frame-list)))
2535 (when (and (display-graphic-p frame) (frame-focus-state frame))
2536 (setf any-graphical-focused t)
2537 (setf frame-list nil))))
2538 any-graphical-focused)))
2539 2552
2540(defun blink-cursor-check () 2553(defun blink-cursor-check ()
2541 "Check if cursor blinking shall be restarted. 2554 "Check if cursor blinking shall be restarted.
@@ -2544,7 +2557,7 @@ stopped by `blink-cursor-suspend'. Internally calls
2544`blink-cursor--should-blink' and returns its result." 2557`blink-cursor--should-blink' and returns its result."
2545 (let ((should-blink (blink-cursor--should-blink))) 2558 (let ((should-blink (blink-cursor--should-blink)))
2546 (when (and should-blink (not blink-cursor-idle-timer)) 2559 (when (and should-blink (not blink-cursor-idle-timer))
2547 (remove-hook 'post-command-hook 'blink-cursor-check) 2560 (remove-hook 'post-command-hook #'blink-cursor-check)
2548 (blink-cursor--start-idle-timer)) 2561 (blink-cursor--start-idle-timer))
2549 should-blink)) 2562 should-blink))
2550 2563
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d826faca5bd..6b5a21eaf55 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1615,7 +1615,7 @@ It is a string, such as \"PGP\". If nil, ask user."
1615 :group 'gnus-article 1615 :group 'gnus-article
1616 :type 'boolean) 1616 :type 'boolean)
1617 1617
1618(defcustom gnus-blocked-images 'gnus-block-private-groups 1618(defcustom gnus-blocked-images #'gnus-block-private-groups
1619 "Images that have URLs matching this regexp will be blocked. 1619 "Images that have URLs matching this regexp will be blocked.
1620Note that the main reason external images are included in HTML 1620Note that the main reason external images are included in HTML
1621emails (these days) is to allow tracking whether you've read the 1621emails (these days) is to allow tracking whether you've read the
@@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system."
2693 "Format an HTML article." 2693 "Format an HTML article."
2694 (interactive) 2694 (interactive)
2695 (let ((handles nil) 2695 (let ((handles nil)
2696 (buffer-read-only nil)) 2696 (inhibit-read-only t))
2697 (when (gnus-buffer-live-p gnus-original-article-buffer) 2697 (when (gnus-buffer-live-p gnus-original-article-buffer)
2698 (with-current-buffer gnus-original-article-buffer 2698 (with-current-buffer gnus-original-article-buffer
2699 (setq handles (mm-dissect-buffer t t)))) 2699 (setq handles (mm-dissect-buffer t t))))
@@ -4302,71 +4302,67 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4302 (canlock-verify gnus-original-article-buffer))) 4302 (canlock-verify gnus-original-article-buffer)))
4303 4303
4304(eval-and-compile 4304(eval-and-compile
4305 (mapc 4305 (defmacro gnus-art-defun (gnus-fun &optional article-fun)
4306 (lambda (func) 4306 "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer."
4307 (let (afunc gfunc) 4307 (unless article-fun
4308 (if (consp func) 4308 (if (not (string-match "\\`gnus-" (symbol-name gnus-fun)))
4309 (setq afunc (car func) 4309 (error "Can't guess article-fun argument")
4310 gfunc (cdr func)) 4310 (setq article-fun (intern (substring (symbol-name gnus-fun)
4311 (setq afunc func 4311 (match-end 0))))))
4312 gfunc (intern (format "gnus-%s" func)))) 4312 `(defun ,gnus-fun (&optional interactive &rest args)
4313 (defalias gfunc 4313 ,(format "Run `%s' in the article buffer." article-fun)
4314 (when (fboundp afunc) 4314 (interactive (list t))
4315 `(lambda (&optional interactive &rest args) 4315 (with-current-buffer gnus-article-buffer
4316 ,(documentation afunc t) 4316 (if interactive
4317 (interactive (list t)) 4317 (call-interactively ',article-fun)
4318 (with-current-buffer gnus-article-buffer 4318 (apply #',article-fun args))))))
4319 (if interactive 4319(gnus-art-defun gnus-article-hide-headers)
4320 (call-interactively ',afunc) 4320(gnus-art-defun gnus-article-verify-x-pgp-sig)
4321 (apply #',afunc args)))))))) 4321(gnus-art-defun gnus-article-verify-cancel-lock)
4322 '(article-hide-headers 4322(gnus-art-defun gnus-article-hide-boring-headers)
4323 article-verify-x-pgp-sig 4323(gnus-art-defun gnus-article-treat-overstrike)
4324 article-verify-cancel-lock 4324(gnus-art-defun gnus-article-treat-ansi-sequences)
4325 article-hide-boring-headers 4325(gnus-art-defun gnus-article-fill-long-lines)
4326 article-treat-overstrike 4326(gnus-art-defun gnus-article-capitalize-sentences)
4327 article-treat-ansi-sequences 4327(gnus-art-defun gnus-article-remove-cr)
4328 article-fill-long-lines 4328(gnus-art-defun gnus-article-remove-leading-whitespace)
4329 article-capitalize-sentences 4329(gnus-art-defun gnus-article-display-x-face)
4330 article-remove-cr 4330(gnus-art-defun gnus-article-display-face)
4331 article-remove-leading-whitespace 4331(gnus-art-defun gnus-article-de-quoted-unreadable)
4332 article-display-x-face 4332(gnus-art-defun gnus-article-de-base64-unreadable)
4333 article-display-face 4333(gnus-art-defun gnus-article-decode-HZ)
4334 article-de-quoted-unreadable 4334(gnus-art-defun gnus-article-wash-html)
4335 article-de-base64-unreadable 4335(gnus-art-defun gnus-article-unsplit-urls)
4336 article-decode-HZ 4336(gnus-art-defun gnus-article-hide-list-identifiers)
4337 article-wash-html 4337(gnus-art-defun gnus-article-strip-banner)
4338 article-unsplit-urls 4338(gnus-art-defun gnus-article-babel)
4339 article-hide-list-identifiers 4339(gnus-art-defun gnus-article-hide-pem)
4340 article-strip-banner 4340(gnus-art-defun gnus-article-hide-signature)
4341 article-babel 4341(gnus-art-defun gnus-article-strip-headers-in-body)
4342 article-hide-pem 4342(gnus-art-defun gnus-article-remove-trailing-blank-lines)
4343 article-hide-signature 4343(gnus-art-defun gnus-article-strip-leading-blank-lines)
4344 article-strip-headers-in-body 4344(gnus-art-defun gnus-article-strip-multiple-blank-lines)
4345 article-remove-trailing-blank-lines 4345(gnus-art-defun gnus-article-strip-leading-space)
4346 article-strip-leading-blank-lines 4346(gnus-art-defun gnus-article-strip-trailing-space)
4347 article-strip-multiple-blank-lines 4347(gnus-art-defun gnus-article-strip-blank-lines)
4348 article-strip-leading-space 4348(gnus-art-defun gnus-article-strip-all-blank-lines)
4349 article-strip-trailing-space 4349(gnus-art-defun gnus-article-date-local)
4350 article-strip-blank-lines 4350(gnus-art-defun gnus-article-date-english)
4351 article-strip-all-blank-lines 4351(gnus-art-defun gnus-article-date-iso8601)
4352 article-date-local 4352(gnus-art-defun gnus-article-date-original)
4353 article-date-english 4353(gnus-art-defun gnus-article-treat-date)
4354 article-date-iso8601 4354(gnus-art-defun gnus-article-date-ut)
4355 article-date-original 4355(gnus-art-defun gnus-article-decode-mime-words)
4356 article-treat-date 4356(gnus-art-defun gnus-article-decode-charset)
4357 article-date-ut 4357(gnus-art-defun gnus-article-decode-encoded-words)
4358 article-decode-mime-words 4358(gnus-art-defun gnus-article-date-user)
4359 article-decode-charset 4359(gnus-art-defun gnus-article-date-lapsed)
4360 article-decode-encoded-words 4360(gnus-art-defun gnus-article-date-combined-lapsed)
4361 article-date-user 4361(gnus-art-defun gnus-article-emphasize)
4362 article-date-lapsed 4362(gnus-art-defun gnus-article-treat-dumbquotes)
4363 article-date-combined-lapsed 4363(gnus-art-defun gnus-article-treat-non-ascii)
4364 article-emphasize 4364(gnus-art-defun gnus-article-normalize-headers)
4365 article-treat-dumbquotes 4365;;(gnus-art-defun gnus-article-show-all-headers article-show-all)
4366 article-treat-non-ascii
4367 article-normalize-headers
4368 ;;(article-show-all . gnus-article-show-all-headers)
4369 )))
4370 4366
4371;;; 4367;;;
4372;;; Gnus article mode 4368;;; Gnus article mode
@@ -4869,17 +4865,18 @@ General format specifiers can also be used. See Info node
4869(defvar gnus-mime-button-map 4865(defvar gnus-mime-button-map
4870 (let ((map (make-sparse-keymap))) 4866 (let ((map (make-sparse-keymap)))
4871 (define-key map [mouse-2] 'gnus-article-push-button) 4867 (define-key map [mouse-2] 'gnus-article-push-button)
4872 (define-key map [down-mouse-3] 'gnus-mime-button-menu)
4873 (dolist (c gnus-mime-button-commands) 4868 (dolist (c gnus-mime-button-commands)
4874 (define-key map (cadr c) (car c))) 4869 (define-key map (cadr c) (car c)))
4875 map))
4876 4870
4877(easy-menu-define 4871 (easy-menu-define gnus-mime-button-menu map "MIME button menu."
4878 gnus-mime-button-menu gnus-mime-button-map "MIME button menu." 4872 `("MIME Part"
4879 `("MIME Part" 4873 ,@(mapcar (lambda (c)
4880 ,@(mapcar (lambda (c) 4874 (vector (caddr c) (car c) :active t))
4881 (vector (caddr c) (car c) :active t)) 4875 gnus-mime-button-commands)))
4882 gnus-mime-button-commands))) 4876
4877 (define-key map [down-mouse-3]
4878 (easy-menu-binding gnus-mime-button-menu))
4879 map))
4883 4880
4884(defvar gnus-url-button-commands 4881(defvar gnus-url-button-commands
4885 '((gnus-article-copy-string "u" "Copy URL to kill ring"))) 4882 '((gnus-article-copy-string "u" "Copy URL to kill ring")))
@@ -4923,16 +4920,6 @@ General format specifiers can also be used. See Info node
4923 (setq mm-w3m-safe-url-regexp nil))) 4920 (setq mm-w3m-safe-url-regexp nil)))
4924 ,@body)) 4921 ,@body))
4925 4922
4926(defun gnus-mime-button-menu (event prefix)
4927 "Construct a context-sensitive menu of MIME commands."
4928 (interactive "e\nP")
4929 (save-window-excursion
4930 (let ((pos (event-start event)))
4931 (select-window (posn-window pos))
4932 (goto-char (posn-point pos))
4933 (gnus-article-check-buffer)
4934 (popup-menu gnus-mime-button-menu nil prefix))))
4935
4936(defun gnus-mime-view-all-parts (&optional handles) 4923(defun gnus-mime-view-all-parts (&optional handles)
4937 "View all the MIME parts." 4924 "View all the MIME parts."
4938 (interactive) 4925 (interactive)
@@ -5055,10 +5042,12 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
5055 nil nil))) 5042 nil nil)))
5056 (gnus-mime-save-part-and-strip file)) 5043 (gnus-mime-save-part-and-strip file))
5057 5044
5058(defun gnus-mime-save-part-and-strip (&optional file) 5045(defun gnus-mime-save-part-and-strip (&optional file event)
5059 "Save the MIME part under point then replace it with an external body. 5046 "Save the MIME part under point then replace it with an external body.
5060If FILE is given, use it for the external part." 5047If FILE is given, use it for the external part."
5061 (interactive) 5048 (interactive (list nil last-nonmenu-event))
5049 (save-excursion
5050 (mouse-set-point event)
5062 (gnus-article-check-buffer) 5051 (gnus-article-check-buffer)
5063 (when (gnus-group-read-only-p) 5052 (when (gnus-group-read-only-p)
5064 (error "The current group does not support deleting of parts")) 5053 (error "The current group does not support deleting of parts"))
@@ -5090,15 +5079,16 @@ The current article has a complicated MIME structure, giving up..."))
5090 (access-type . "LOCAL-FILE") 5079 (access-type . "LOCAL-FILE")
5091 (name . ,file))))) 5080 (name . ,file)))))
5092 ;; (set-buffer gnus-summary-buffer) 5081 ;; (set-buffer gnus-summary-buffer)
5093 (gnus-article-edit-part handles id)))) 5082 (gnus-article-edit-part handles id)))))
5094 5083
5095;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all 5084;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
5096;; parts...>') but with stripping would be nice. 5085;; parts...>') but with stripping would be nice.
5097 5086
5098(defun gnus-mime-delete-part () 5087(defun gnus-mime-delete-part (&optional event)
5099 "Delete the MIME part under point. 5088 "Delete the MIME part under point.
5100Replace it with some information about the removed part." 5089Replace it with some information about the removed part."
5101 (interactive) 5090 (interactive (list last-nonmenu-event))
5091 (mouse-set-point event)
5102 (gnus-article-check-buffer) 5092 (gnus-article-check-buffer)
5103 (when (gnus-group-read-only-p) 5093 (when (gnus-group-read-only-p)
5104 (error "The current group does not support deleting of parts")) 5094 (error "The current group does not support deleting of parts"))
@@ -5144,33 +5134,36 @@ Deleting parts may malfunction or destroy the article; continue? "))
5144 ;; (set-buffer gnus-summary-buffer) 5134 ;; (set-buffer gnus-summary-buffer)
5145 (gnus-article-edit-part handles id)))) 5135 (gnus-article-edit-part handles id))))
5146 5136
5147(defun gnus-mime-save-part () 5137(defun gnus-mime-save-part (&optional event)
5148 "Save the MIME part under point." 5138 "Save the MIME part under point."
5149 (interactive) 5139 (interactive (list last-nonmenu-event))
5140 (mouse-set-point event)
5150 (gnus-article-check-buffer) 5141 (gnus-article-check-buffer)
5151 (let ((data (get-text-property (point) 'gnus-data))) 5142 (let ((data (get-text-property (point) 'gnus-data)))
5152 (when data 5143 (when data
5153 (mm-save-part data)))) 5144 (mm-save-part data))))
5154 5145
5155(defun gnus-mime-pipe-part (&optional cmd) 5146(defun gnus-mime-pipe-part (&optional cmd event)
5156 "Pipe the MIME part under point to a process. 5147 "Pipe the MIME part under point to a process."
5157Use CMD as the process." 5148 (interactive (list nil last-nonmenu-event))
5158 (interactive) 5149 (mouse-set-point event)
5159 (gnus-article-check-buffer) 5150 (gnus-article-check-buffer)
5160 (let ((data (get-text-property (point) 'gnus-data))) 5151 (let ((data (get-text-property (point) 'gnus-data)))
5161 (when data 5152 (when data
5162 (mm-pipe-part data cmd)))) 5153 (mm-pipe-part data cmd))))
5163 5154
5164(defun gnus-mime-view-part () 5155(defun gnus-mime-view-part (&optional event)
5165 "Interactively choose a viewing method for the MIME part under point." 5156 "Interactively choose a viewing method for the MIME part under point."
5166 (interactive) 5157 (interactive (list last-nonmenu-event))
5167 (gnus-article-check-buffer) 5158 (save-excursion
5168 (let ((data (get-text-property (point) 'gnus-data))) 5159 (mouse-set-point event)
5169 (when data 5160 (gnus-article-check-buffer)
5170 (setq gnus-article-mime-handles 5161 (let ((data (get-text-property (point) 'gnus-data)))
5171 (mm-merge-handles 5162 (when data
5172 gnus-article-mime-handles (setq data (copy-sequence data)))) 5163 (setq gnus-article-mime-handles
5173 (mm-interactively-view-part data)))) 5164 (mm-merge-handles
5165 gnus-article-mime-handles (setq data (copy-sequence data))))
5166 (mm-interactively-view-part data)))))
5174 5167
5175(defun gnus-mime-view-part-as-type-internal () 5168(defun gnus-mime-view-part-as-type-internal ()
5176 (gnus-article-check-buffer) 5169 (gnus-article-check-buffer)
@@ -5187,11 +5180,13 @@ Use CMD as the process."
5187 '("text/plain" . 0)) 5180 '("text/plain" . 0))
5188 '("application/octet-stream" . 0)))) 5181 '("application/octet-stream" . 0))))
5189 5182
5190(defun gnus-mime-view-part-as-type (&optional mime-type pred) 5183(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
5191 "Choose a MIME media type, and view the part as such. 5184 "Choose a MIME media type, and view the part as such.
5192If non-nil, PRED is a predicate to use during completion to limit the 5185If non-nil, PRED is a predicate to use during completion to limit the
5193available media-types." 5186available media-types."
5194 (interactive) 5187 (interactive (list nil nil last-nonmenu-event))
5188 (save-excursion
5189 (if event (mouse-set-point event))
5195 (unless mime-type 5190 (unless mime-type
5196 (setq mime-type 5191 (setq mime-type
5197 (let ((default (gnus-mime-view-part-as-type-internal))) 5192 (let ((default (gnus-mime-view-part-as-type-internal)))
@@ -5222,13 +5217,14 @@ available media-types."
5222 (mm-merge-handles gnus-article-mime-handles handle)) 5217 (mm-merge-handles gnus-article-mime-handles handle))
5223 (when (mm-handle-displayed-p handle) 5218 (when (mm-handle-displayed-p handle)
5224 (mm-remove-part handle)) 5219 (mm-remove-part handle))
5225 (gnus-mm-display-part handle)))) 5220 (gnus-mm-display-part handle)))))
5226 5221
5227(defun gnus-mime-copy-part (&optional handle arg) 5222(defun gnus-mime-copy-part (&optional handle arg event)
5228 "Put the MIME part under point into a new buffer. 5223 "Put the MIME part under point into a new buffer.
5229If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 5224If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
5230are decompressed." 5225are decompressed."
5231 (interactive (list nil current-prefix-arg)) 5226 (interactive (list nil current-prefix-arg last-nonmenu-event))
5227 (mouse-set-point event)
5232 (gnus-article-check-buffer) 5228 (gnus-article-check-buffer)
5233 (unless handle 5229 (unless handle
5234 (setq handle (get-text-property (point) 'gnus-data))) 5230 (setq handle (get-text-property (point) 'gnus-data)))
@@ -5280,9 +5276,12 @@ are decompressed."
5280 (setq buffer-file-name nil)) 5276 (setq buffer-file-name nil))
5281 (goto-char (point-min))))) 5277 (goto-char (point-min)))))
5282 5278
5283(defun gnus-mime-print-part (&optional handle filename) 5279(defun gnus-mime-print-part (&optional handle filename event)
5284 "Print the MIME part under point." 5280 "Print the MIME part under point."
5285 (interactive (list nil (ps-print-preprint current-prefix-arg))) 5281 (interactive
5282 (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
5283 (save-excursion
5284 (mouse-set-point event)
5286 (gnus-article-check-buffer) 5285 (gnus-article-check-buffer)
5287 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5286 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5288 (contents (and handle (mm-get-part handle))) 5287 (contents (and handle (mm-get-part handle)))
@@ -5303,12 +5302,13 @@ are decompressed."
5303 (with-temp-buffer 5302 (with-temp-buffer
5304 (insert contents) 5303 (insert contents)
5305 (gnus-print-buffer)) 5304 (gnus-print-buffer))
5306 (ps-despool filename))))) 5305 (ps-despool filename))))))
5307 5306
5308(defun gnus-mime-inline-part (&optional handle arg) 5307(defun gnus-mime-inline-part (&optional handle arg event)
5309 "Insert the MIME part under point into the current buffer. 5308 "Insert the MIME part under point into the current buffer.
5310Compressed files like .gz and .bz2 are decompressed." 5309Compressed files like .gz and .bz2 are decompressed."
5311 (interactive (list nil current-prefix-arg)) 5310 (interactive (list nil current-prefix-arg last-nonmenu-event))
5311 (if event (mouse-set-point event))
5312 (gnus-article-check-buffer) 5312 (gnus-article-check-buffer)
5313 (let* ((inhibit-read-only t) 5313 (let* ((inhibit-read-only t)
5314 (b (point)) 5314 (b (point))
@@ -5402,10 +5402,12 @@ CHARSET may either be a string or a symbol."
5402 (setcdr param charset) 5402 (setcdr param charset)
5403 (setcdr type (cons (cons 'charset charset) (cdr type))))))) 5403 (setcdr type (cons (cons 'charset charset) (cdr type)))))))
5404 5404
5405(defun gnus-mime-view-part-as-charset (&optional handle arg) 5405(defun gnus-mime-view-part-as-charset (&optional handle arg event)
5406 "Insert the MIME part under point into the current buffer using the 5406 "Insert the MIME part under point into the current buffer using the
5407specified charset." 5407specified charset."
5408 (interactive (list nil current-prefix-arg)) 5408 (interactive (list nil current-prefix-arg last-nonmenu-event))
5409 (save-excursion
5410 (mouse-set-point event)
5409 (gnus-article-check-buffer) 5411 (gnus-article-check-buffer)
5410 (let ((handle (or handle (get-text-property (point) 'gnus-data))) 5412 (let ((handle (or handle (get-text-property (point) 'gnus-data)))
5411 (fun (get-text-property (point) 'gnus-callback)) 5413 (fun (get-text-property (point) 'gnus-callback))
@@ -5439,11 +5441,13 @@ specified charset."
5439 (setcar (cddr form) 5441 (setcar (cddr form)
5440 (list 'quote (or (cadr (member preferred parts)) 5442 (list 'quote (or (cadr (member preferred parts))
5441 (car parts))))) 5443 (car parts)))))
5442 (funcall fun handle))))) 5444 (funcall fun handle))))))
5443 5445
5444(defun gnus-mime-view-part-externally (&optional handle) 5446(defun gnus-mime-view-part-externally (&optional handle event)
5445 "View the MIME part under point with an external viewer." 5447 "View the MIME part under point with an external viewer."
5446 (interactive) 5448 (interactive (list nil last-nonmenu-event))
5449 (save-excursion
5450 (mouse-set-point event)
5447 (gnus-article-check-buffer) 5451 (gnus-article-check-buffer)
5448 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5452 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5449 (mm-inlined-types nil) 5453 (mm-inlined-types nil)
@@ -5458,12 +5462,14 @@ specified charset."
5458 (gnus-mime-view-part-as-type 5462 (gnus-mime-view-part-as-type
5459 nil (lambda (type) (stringp (mailcap-mime-info type)))) 5463 nil (lambda (type) (stringp (mailcap-mime-info type))))
5460 (when handle 5464 (when handle
5461 (mm-display-part handle nil t))))) 5465 (mm-display-part handle nil t))))))
5462 5466
5463(defun gnus-mime-view-part-internally (&optional handle) 5467(defun gnus-mime-view-part-internally (&optional handle event)
5464 "View the MIME part under point with an internal viewer. 5468 "View the MIME part under point with an internal viewer.
5465If no internal viewer is available, use an external viewer." 5469If no internal viewer is available, use an external viewer."
5466 (interactive) 5470 (interactive (list nil last-nonmenu-event))
5471 (save-excursion
5472 (mouse-set-point event)
5467 (gnus-article-check-buffer) 5473 (gnus-article-check-buffer)
5468 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5474 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5469 (mm-inlined-types '(".*")) 5475 (mm-inlined-types '(".*"))
@@ -5477,7 +5483,7 @@ If no internal viewer is available, use an external viewer."
5477 (gnus-mime-view-part-as-type 5483 (gnus-mime-view-part-as-type
5478 nil (lambda (type) (mm-inlinable-p handle type))) 5484 nil (lambda (type) (mm-inlinable-p handle type)))
5479 (when handle 5485 (when handle
5480 (gnus-bind-mm-vars (mm-display-part handle nil t)))))) 5486 (gnus-bind-mm-vars (mm-display-part handle nil t)))))))
5481 5487
5482(defun gnus-mime-action-on-part (&optional action) 5488(defun gnus-mime-action-on-part (&optional action)
5483 "Do something with the MIME attachment at (point)." 5489 "Do something with the MIME attachment at (point)."
@@ -5849,7 +5855,7 @@ all parts."
5849 (widget-convert-button 5855 (widget-convert-button
5850 'link b e 5856 'link b e
5851 :mime-handle handle 5857 :mime-handle handle
5852 :action 'gnus-widget-press-button 5858 :action #'gnus-widget-press-button
5853 :button-keymap gnus-mime-button-map 5859 :button-keymap gnus-mime-button-map
5854 :help-echo 5860 :help-echo
5855 (lambda (widget) 5861 (lambda (widget)
@@ -6148,7 +6154,7 @@ If nil, don't show those extra buttons."
6148 article-type multipart 6154 article-type multipart
6149 rear-nonsticky t)) 6155 rear-nonsticky t))
6150 (widget-convert-button 'link from (point) 6156 (widget-convert-button 'link from (point)
6151 :action 'gnus-widget-press-button) 6157 :action #'gnus-widget-press-button)
6152 ;; Do the handles 6158 ;; Do the handles
6153 (while (setq handle (pop handles)) 6159 (while (setq handle (pop handles))
6154 (add-text-properties 6160 (add-text-properties
@@ -6172,7 +6178,7 @@ If nil, don't show those extra buttons."
6172 gnus-data ,handle 6178 gnus-data ,handle
6173 rear-nonsticky t)) 6179 rear-nonsticky t))
6174 (widget-convert-button 'link from (point) 6180 (widget-convert-button 'link from (point)
6175 :action 'gnus-widget-press-button) 6181 :action #'gnus-widget-press-button)
6176 (insert " ")) 6182 (insert " "))
6177 (insert "\n\n")) 6183 (insert "\n\n"))
6178 (when preferred 6184 (when preferred
@@ -7115,13 +7121,11 @@ If given a prefix, show the hidden text instead."
7115 (when (and do-update-line 7121 (when (and do-update-line
7116 (or (numberp article) 7122 (or (numberp article)
7117 (stringp article))) 7123 (stringp article)))
7118 (let ((buf (current-buffer))) 7124 (with-current-buffer gnus-summary-buffer
7119 (set-buffer gnus-summary-buffer)
7120 (gnus-summary-update-article do-update-line sparse-header) 7125 (gnus-summary-update-article do-update-line sparse-header)
7121 (gnus-summary-goto-subject do-update-line nil t) 7126 (gnus-summary-goto-subject do-update-line nil t)
7122 (set-window-point (gnus-get-buffer-window (current-buffer) t) 7127 (set-window-point (gnus-get-buffer-window (current-buffer) t)
7123 (point)) 7128 (point)))))))
7124 (set-buffer buf))))))
7125 7129
7126(defun gnus-block-private-groups (group) 7130(defun gnus-block-private-groups (group)
7127 "Allows images in newsgroups to be shown, blocks images in all 7131 "Allows images in newsgroups to be shown, blocks images in all
@@ -7316,8 +7320,7 @@ groups."
7316 (gnus-article-mode) 7320 (gnus-article-mode)
7317 (set-window-configuration winconf) 7321 (set-window-configuration winconf)
7318 ;; Tippy-toe some to make sure that point remains where it was. 7322 ;; Tippy-toe some to make sure that point remains where it was.
7319 (save-current-buffer 7323 (with-current-buffer curbuf
7320 (set-buffer curbuf)
7321 (set-window-start (get-buffer-window (current-buffer)) window-start) 7324 (set-window-start (get-buffer-window (current-buffer)) window-start)
7322 (goto-char p)))) 7325 (goto-char p))))
7323 (gnus-summary-show-article))) 7326 (gnus-summary-show-article)))
@@ -7869,15 +7872,16 @@ call it with the value of the `gnus-data' text property."
7869 (when fun 7872 (when fun
7870 (funcall fun data)))) 7873 (funcall fun data))))
7871 7874
7872(defun gnus-article-press-button () 7875(defun gnus-article-press-button (&optional event)
7873 "Check text at point for a callback function. 7876 "Check text at point for a callback function.
7874If the text at point has a `gnus-callback' property, 7877If the text at point has a `gnus-callback' property,
7875call it with the value of the `gnus-data' text property." 7878call it with the value of the `gnus-data' text property."
7876 (interactive) 7879 (interactive (list last-nonmenu-event))
7877 (let ((data (get-text-property (point) 'gnus-data)) 7880 (save-excursion
7878 (fun (get-text-property (point) 'gnus-callback))) 7881 (mouse-set-point event)
7879 (when fun 7882 (let ((fun (get-text-property (point) 'gnus-callback)))
7880 (funcall fun data)))) 7883 (when fun
7884 (funcall fun (get-text-property (point) 'gnus-data))))))
7881 7885
7882(defun gnus-article-highlight (&optional force) 7886(defun gnus-article-highlight (&optional force)
7883 "Highlight current article. 7887 "Highlight current article.
@@ -8095,7 +8099,7 @@ url is put as the `gnus-button-url' overlay property on the button."
8095 (list 'mouse-face gnus-article-mouse-face)) 8099 (list 'mouse-face gnus-article-mouse-face))
8096 (list 'gnus-callback fun) 8100 (list 'gnus-callback fun)
8097 (and data (list 'gnus-data data)))) 8101 (and data (list 'gnus-data data))))
8098 (widget-convert-button 'link from to :action 'gnus-widget-press-button 8102 (widget-convert-button 'link from to :action #'gnus-widget-press-button
8099 :help-echo (or text "Follow the link") 8103 :help-echo (or text "Follow the link")
8100 :keymap gnus-url-button-map)) 8104 :keymap gnus-url-button-map))
8101 8105
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 485f815d9b9..9ae28b1290e 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -1,4 +1,4 @@
1;;; gnus-cloud.el --- storing and retrieving data via IMAP 1;;; gnus-cloud.el --- storing and retrieving data via IMAP -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2014-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
4 4
@@ -52,14 +52,12 @@ Each element may be either a string or a property list.
52The latter should have a :directory element whose value is a string, 52The latter should have a :directory element whose value is a string,
53and a :match element whose value is a regular expression to match 53and a :match element whose value is a regular expression to match
54against the basename of files in said directory." 54against the basename of files in said directory."
55 :group 'gnus-cloud
56 :type '(repeat (choice (string :tag "File") 55 :type '(repeat (choice (string :tag "File")
57 (plist :tag "Property list")))) 56 (plist :tag "Property list"))))
58 57
59(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) 58(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
60 "Storage method for cloud data, defaults to EPG if that's available." 59 "Storage method for cloud data, defaults to EPG if that's available."
61 :version "26.1" 60 :version "26.1"
62 :group 'gnus-cloud
63 :type '(radio (const :tag "No encoding" nil) 61 :type '(radio (const :tag "No encoding" nil)
64 (const :tag "Base64" base64) 62 (const :tag "Base64" base64)
65 (const :tag "Base64+gzip" base64-gzip) 63 (const :tag "Base64+gzip" base64-gzip)
@@ -68,7 +66,6 @@ against the basename of files in said directory."
68(defcustom gnus-cloud-interactive t 66(defcustom gnus-cloud-interactive t
69 "Whether Gnus Cloud changes should be confirmed." 67 "Whether Gnus Cloud changes should be confirmed."
70 :version "26.1" 68 :version "26.1"
71 :group 'gnus-cloud
72 :type 'boolean) 69 :type 'boolean)
73 70
74(defvar gnus-cloud-group-name "Emacs-Cloud") 71(defvar gnus-cloud-group-name "Emacs-Cloud")
@@ -81,7 +78,6 @@ against the basename of files in said directory."
81 "The IMAP select method used to store the cloud data. 78 "The IMAP select method used to store the cloud data.
82See also `gnus-server-set-cloud-method-server' for an 79See also `gnus-server-set-cloud-method-server' for an
83easy interactive way to set this from the Server buffer." 80easy interactive way to set this from the Server buffer."
84 :group 'gnus-cloud
85 :type '(radio (const :tag "Not set" nil) 81 :type '(radio (const :tag "Not set" nil)
86 (string :tag "A Gnus server name as a string"))) 82 (string :tag "A Gnus server name as a string")))
87 83
@@ -131,8 +127,7 @@ easy interactive way to set this from the Server buffer."
131 (base64-encode-region (point-min) (point-max))) 127 (base64-encode-region (point-min) (point-max)))
132 128
133 ((eq gnus-cloud-storage-method 'epg) 129 ((eq gnus-cloud-storage-method 'epg)
134 (let ((context (epg-make-context 'OpenPGP)) 130 (let ((context (epg-make-context 'OpenPGP)))
135 cipher)
136 (setf (epg-context-armor context) t) 131 (setf (epg-context-armor context) t)
137 (setf (epg-context-textmode context) t) 132 (setf (epg-context-textmode context) t)
138 (let ((data (epg-encrypt-string context 133 (let ((data (epg-encrypt-string context
@@ -353,6 +348,7 @@ Use old data if FORCE-OLDER is not nil."
353 (group &optional previous method)) 348 (group &optional previous method))
354 349
355(defun gnus-cloud-ensure-cloud-group () 350(defun gnus-cloud-ensure-cloud-group ()
351 ;; FIXME: `method' is not used!?
356 (let ((method (if (stringp gnus-cloud-method) 352 (let ((method (if (stringp gnus-cloud-method)
357 (gnus-server-to-method gnus-cloud-method) 353 (gnus-server-to-method gnus-cloud-method)
358 gnus-cloud-method))) 354 gnus-cloud-method)))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index e2c728df8f4..4d10e1170da 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -644,7 +644,14 @@ articles in the topic and its subtopics."
644 (add-text-properties 644 (add-text-properties
645 (point) 645 (point)
646 (prog1 (1+ (point)) 646 (prog1 (1+ (point))
647 (eval gnus-topic-line-format-spec)) 647 (eval gnus-topic-line-format-spec
648 `((indentation . ,indentation)
649 (visible . ,visible)
650 (name . ,name)
651 (level . ,level)
652 (number-of-groups . ,number-of-groups)
653 (total-number-of-articles . ,total-number-of-articles)
654 (entries . ,entries))))
648 (list 'gnus-topic name 655 (list 'gnus-topic name
649 'gnus-topic-level level 656 'gnus-topic-level level
650 'gnus-topic-unread unread 657 'gnus-topic-unread unread
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 31421cc7555..fcd5ec621cc 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -38,7 +38,7 @@
38(require 'time-date) 38(require 'time-date)
39(require 'text-property-search) 39(require 'text-property-search)
40 40
41(defcustom gnus-completing-read-function 'gnus-emacs-completing-read 41(defcustom gnus-completing-read-function #'gnus-emacs-completing-read
42 "Function use to do completing read." 42 "Function use to do completing read."
43 :version "24.1" 43 :version "24.1"
44 :group 'gnus-meta 44 :group 'gnus-meta
@@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen."
87 87
88(defmacro gnus-eval-in-buffer-window (buffer &rest forms) 88(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
89 "Pop to BUFFER, evaluate FORMS, and then return to the original window." 89 "Pop to BUFFER, evaluate FORMS, and then return to the original window."
90 (declare (indent 1) (debug (form body)))
90 (let ((tempvar (make-symbol "GnusStartBufferWindow")) 91 (let ((tempvar (make-symbol "GnusStartBufferWindow"))
91 (w (make-symbol "w")) 92 (w (make-symbol "w"))
92 (buf (make-symbol "buf"))) 93 (buf (make-symbol "buf")))
@@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen."
103 ,@forms) 104 ,@forms)
104 (select-window ,tempvar))))) 105 (select-window ,tempvar)))))
105 106
106(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
107(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
108
109(defsubst gnus-goto-char (point) 107(defsubst gnus-goto-char (point)
110 (and point (goto-char point))) 108 (and point (goto-char point)))
111 109
@@ -302,26 +300,24 @@ Symbols are also allowed; their print names are used instead."
302 300
303(defmacro gnus-local-set-keys (&rest plist) 301(defmacro gnus-local-set-keys (&rest plist)
304 "Set the keys in PLIST in the current keymap." 302 "Set the keys in PLIST in the current keymap."
303 (declare (indent 1))
305 `(gnus-define-keys-1 (current-local-map) ',plist)) 304 `(gnus-define-keys-1 (current-local-map) ',plist))
306 305
307(defmacro gnus-define-keys (keymap &rest plist) 306(defmacro gnus-define-keys (keymap &rest plist)
308 "Define all keys in PLIST in KEYMAP." 307 "Define all keys in PLIST in KEYMAP."
308 (declare (indent 1))
309 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) 309 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
310 310
311(defmacro gnus-define-keys-safe (keymap &rest plist) 311(defmacro gnus-define-keys-safe (keymap &rest plist)
312 "Define all keys in PLIST in KEYMAP without overwriting previous definitions." 312 "Define all keys in PLIST in KEYMAP without overwriting previous definitions."
313 (declare (indent 1))
313 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) 314 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
314 315
315(put 'gnus-define-keys 'lisp-indent-function 1)
316(put 'gnus-define-keys-safe 'lisp-indent-function 1)
317(put 'gnus-local-set-keys 'lisp-indent-function 1)
318
319(defmacro gnus-define-keymap (keymap &rest plist) 316(defmacro gnus-define-keymap (keymap &rest plist)
320 "Define all keys in PLIST in KEYMAP." 317 "Define all keys in PLIST in KEYMAP."
318 (declare (indent 1))
321 `(gnus-define-keys-1 ,keymap (quote ,plist))) 319 `(gnus-define-keys-1 ,keymap (quote ,plist)))
322 320
323(put 'gnus-define-keymap 'lisp-indent-function 1)
324
325(defun gnus-define-keys-1 (keymap plist &optional safe) 321(defun gnus-define-keys-1 (keymap plist &optional safe)
326 (when (null keymap) 322 (when (null keymap)
327 (error "Can't set keys in a null keymap")) 323 (error "Can't set keys in a null keymap"))
@@ -444,7 +440,7 @@ displayed in the echo area."
444 `(let (str time) 440 `(let (str time)
445 (cond ((eq gnus-add-timestamp-to-message 'log) 441 (cond ((eq gnus-add-timestamp-to-message 'log)
446 (setq str (let (message-log-max) 442 (setq str (let (message-log-max)
447 (apply 'message ,format-string ,args))) 443 (apply #'message ,format-string ,args)))
448 (when (and message-log-max 444 (when (and message-log-max
449 (> message-log-max 0) 445 (> message-log-max 0)
450 (/= (length str) 0)) 446 (/= (length str) 0))
@@ -462,7 +458,7 @@ displayed in the echo area."
462 (gnus-add-timestamp-to-message 458 (gnus-add-timestamp-to-message
463 (if (or (and (null ,format-string) (null ,args)) 459 (if (or (and (null ,format-string) (null ,args))
464 (progn 460 (progn
465 (setq str (apply 'format ,format-string ,args)) 461 (setq str (apply #'format ,format-string ,args))
466 (zerop (length str)))) 462 (zerop (length str))))
467 (prog1 463 (prog1
468 (and ,format-string str) 464 (and ,format-string str)
@@ -471,7 +467,7 @@ displayed in the echo area."
471 (message "%s" (concat ,timestamp str)) 467 (message "%s" (concat ,timestamp str))
472 str)) 468 str))
473 (t 469 (t
474 (apply 'message ,format-string ,args))))))) 470 (apply #'message ,format-string ,args)))))))
475 471
476(defvar gnus-action-message-log nil) 472(defvar gnus-action-message-log nil)
477 473
@@ -490,9 +486,10 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages
490inside loops." 486inside loops."
491 (if (<= level gnus-verbose) 487 (if (<= level gnus-verbose)
492 (let ((message 488 (let ((message
493 (if gnus-add-timestamp-to-message 489 (apply (if gnus-add-timestamp-to-message
494 (apply 'gnus-message-with-timestamp args) 490 #'gnus-message-with-timestamp
495 (apply 'message args)))) 491 #'message)
492 args)))
496 (when (and (consp gnus-action-message-log) 493 (when (and (consp gnus-action-message-log)
497 (<= level 3)) 494 (<= level 3))
498 (push message gnus-action-message-log)) 495 (push message gnus-action-message-log))
@@ -500,7 +497,7 @@ inside loops."
500 ;; We have to do this format thingy here even if the result isn't 497 ;; We have to do this format thingy here even if the result isn't
501 ;; shown - the return value has to be the same as the return value 498 ;; shown - the return value has to be the same as the return value
502 ;; from `message'. 499 ;; from `message'.
503 (apply 'format args))) 500 (apply #'format args)))
504 501
505(defun gnus-final-warning () 502(defun gnus-final-warning ()
506 (when (and (consp gnus-action-message-log) 503 (when (and (consp gnus-action-message-log)
@@ -513,7 +510,7 @@ inside loops."
513 "Beep an error if LEVEL is equal to or less than `gnus-verbose'. 510 "Beep an error if LEVEL is equal to or less than `gnus-verbose'.
514ARGS are passed to `message'." 511ARGS are passed to `message'."
515 (when (<= (floor level) gnus-verbose) 512 (when (<= (floor level) gnus-verbose)
516 (apply 'message args) 513 (apply #'message args)
517 (ding) 514 (ding)
518 (let (duration) 515 (let (duration)
519 (when (and (floatp level) 516 (when (and (floatp level)
@@ -688,18 +685,20 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably'
688to t, and `print-escape-multibyte', `print-escape-newlines', 685to t, and `print-escape-multibyte', `print-escape-newlines',
689`print-escape-nonascii', `print-length', `print-level' and 686`print-escape-nonascii', `print-length', `print-level' and
690`print-string-length' to nil." 687`print-string-length' to nil."
691 `(let ((print-quoted t) 688 `(progn
692 (print-readably t) 689 (defvar print-string-length) (defvar print-readably)
693 ;;print-circle 690 (let ((print-quoted t)
694 ;;print-continuous-numbering 691 (print-readably t)
695 print-escape-multibyte 692 ;;print-circle
696 print-escape-newlines 693 ;;print-continuous-numbering
697 print-escape-nonascii 694 print-escape-multibyte
698 ;;print-gensym 695 print-escape-newlines
699 print-length 696 print-escape-nonascii
700 print-level 697 ;;print-gensym
701 print-string-length) 698 print-length
702 ,@forms)) 699 print-level
700 print-string-length)
701 ,@forms)))
703 702
704(defun gnus-prin1 (form) 703(defun gnus-prin1 (form)
705 "Use `prin1' on FORM in the current buffer. 704 "Use `prin1' on FORM in the current buffer.
@@ -852,11 +851,10 @@ the user are disabled, it is recommended that only the most minimal
852operations are performed by FORMS. If you wish to assign many 851operations are performed by FORMS. If you wish to assign many
853complicated values atomically, compute the results into temporary 852complicated values atomically, compute the results into temporary
854variables and then do only the assignment atomically." 853variables and then do only the assignment atomically."
854 (declare (indent 0))
855 `(let ((inhibit-quit gnus-atomic-be-safe)) 855 `(let ((inhibit-quit gnus-atomic-be-safe))
856 ,@forms)) 856 ,@forms))
857 857
858(put 'gnus-atomic-progn 'lisp-indent-function 0)
859
860(defmacro gnus-atomic-progn-assign (protect &rest forms) 858(defmacro gnus-atomic-progn-assign (protect &rest forms)
861 "Evaluate FORMS, but ensure that the variables listed in PROTECT 859 "Evaluate FORMS, but ensure that the variables listed in PROTECT
862are not changed if anything in FORMS signals an error or otherwise 860are not changed if anything in FORMS signals an error or otherwise
@@ -866,6 +864,7 @@ It is safe to use gnus-atomic-progn-assign with long computations.
866Note that if any of the symbols in PROTECT were unbound, they will be 864Note that if any of the symbols in PROTECT were unbound, they will be
867set to nil on a successful assignment. In case of an error or other 865set to nil on a successful assignment. In case of an error or other
868non-local exit, it will still be unbound." 866non-local exit, it will still be unbound."
867 (declare (indent 1)) ;;(debug (sexp body))
869 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol 868 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
870 (concat (symbol-name x) 869 (concat (symbol-name x)
871 "-tmp")) 870 "-tmp"))
@@ -878,8 +877,8 @@ non-local exit, it will still be unbound."
878 ,(cadr x)))) 877 ,(cadr x))))
879 temp-sym-map)) 878 temp-sym-map))
880 (sym-temp-let sym-temp-map) 879 (sym-temp-let sym-temp-map)
881 (temp-sym-assign (apply 'append temp-sym-map)) 880 (temp-sym-assign (apply #'append temp-sym-map))
882 (sym-temp-assign (apply 'append sym-temp-map)) 881 (sym-temp-assign (apply #'append sym-temp-map))
883 (result (make-symbol "result-tmp"))) 882 (result (make-symbol "result-tmp")))
884 `(let (,@temp-sym-let 883 `(let (,@temp-sym-let
885 ,result) 884 ,result)
@@ -890,9 +889,6 @@ non-local exit, it will still be unbound."
890 (setq ,@sym-temp-assign)) 889 (setq ,@sym-temp-assign))
891 ,result))) 890 ,result)))
892 891
893(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
894;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
895
896(defmacro gnus-atomic-setq (&rest pairs) 892(defmacro gnus-atomic-setq (&rest pairs)
897 "Similar to setq, except that the real symbols are only assigned when 893 "Similar to setq, except that the real symbols are only assigned when
898there are no errors. And when the real symbols are assigned, they are 894there are no errors. And when the real symbols are assigned, they are
@@ -1102,16 +1098,16 @@ ARG is passed to the first function."
1102(defun gnus-run-hooks (&rest funcs) 1098(defun gnus-run-hooks (&rest funcs)
1103 "Does the same as `run-hooks', but saves the current buffer." 1099 "Does the same as `run-hooks', but saves the current buffer."
1104 (save-current-buffer 1100 (save-current-buffer
1105 (apply 'run-hooks funcs))) 1101 (apply #'run-hooks funcs)))
1106 1102
1107(defun gnus-run-hook-with-args (hook &rest args) 1103(defun gnus-run-hook-with-args (hook &rest args)
1108 "Does the same as `run-hook-with-args', but saves the current buffer." 1104 "Does the same as `run-hook-with-args', but saves the current buffer."
1109 (save-current-buffer 1105 (save-current-buffer
1110 (apply 'run-hook-with-args hook args))) 1106 (apply #'run-hook-with-args hook args)))
1111 1107
1112(defun gnus-run-mode-hooks (&rest funcs) 1108(defun gnus-run-mode-hooks (&rest funcs)
1113 "Run `run-mode-hooks', saving the current buffer." 1109 "Run `run-mode-hooks', saving the current buffer."
1114 (save-current-buffer (apply 'run-mode-hooks funcs))) 1110 (save-current-buffer (apply #'run-mode-hooks funcs)))
1115 1111
1116;;; Various 1112;;; Various
1117 1113
@@ -1194,6 +1190,7 @@ ARG is passed to the first function."
1194 1190
1195;; Fixme: Why not use `with-output-to-temp-buffer'? 1191;; Fixme: Why not use `with-output-to-temp-buffer'?
1196(defmacro gnus-with-output-to-file (file &rest body) 1192(defmacro gnus-with-output-to-file (file &rest body)
1193 (declare (indent 1) (debug (form body)))
1197 (let ((buffer (make-symbol "output-buffer")) 1194 (let ((buffer (make-symbol "output-buffer"))
1198 (size (make-symbol "output-buffer-size")) 1195 (size (make-symbol "output-buffer-size"))
1199 (leng (make-symbol "output-buffer-length")) 1196 (leng (make-symbol "output-buffer-length"))
@@ -1216,9 +1213,6 @@ ARG is passed to the first function."
1216 (write-region (substring ,buffer 0 ,leng) nil ,file 1213 (write-region (substring ,buffer 0 ,leng) nil ,file
1217 ,append 'no-msg)))))) 1214 ,append 'no-msg))))))
1218 1215
1219(put 'gnus-with-output-to-file 'lisp-indent-function 1)
1220(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
1221
1222(defun gnus-add-text-properties-when 1216(defun gnus-add-text-properties-when
1223 (property value start end properties &optional object) 1217 (property value start end properties &optional object)
1224 "Like `add-text-properties', only applied on where PROPERTY is VALUE." 1218 "Like `add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1306,7 +1300,7 @@ sure of changing the value of `foo'."
1306 (setq gnus-info-buffer (current-buffer)) 1300 (setq gnus-info-buffer (current-buffer))
1307 (gnus-configure-windows 'info))) 1301 (gnus-configure-windows 'info)))
1308 1302
1309(defun gnus-not-ignore (&rest args) 1303(defun gnus-not-ignore (&rest _)
1310 t) 1304 t)
1311 1305
1312(defvar gnus-directory-sep-char-regexp "/" 1306(defvar gnus-directory-sep-char-regexp "/"
@@ -1358,7 +1352,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1358 `(,spec elem)) 1352 `(,spec elem))
1359 ((listp spec) 1353 ((listp spec)
1360 (if (memq (car spec) '(or and not)) 1354 (if (memq (car spec) '(or and not))
1361 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) 1355 `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec)))
1362 (error "Invalid predicate specifier: %s" spec))))) 1356 (error "Invalid predicate specifier: %s" spec)))))
1363 1357
1364(defun gnus-completing-read (prompt collection &optional require-match 1358(defun gnus-completing-read (prompt collection &optional require-match
@@ -1397,6 +1391,8 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1397 ;; Make sure iswitchb is loaded before we let-bind its variables. 1391 ;; Make sure iswitchb is loaded before we let-bind its variables.
1398 ;; If it is loaded inside the let, variables can become unbound afterwards. 1392 ;; If it is loaded inside the let, variables can become unbound afterwards.
1399 (require 'iswitchb) 1393 (require 'iswitchb)
1394 (declare-function iswitchb-minibuffer-setup "iswitchb" ())
1395 (defvar iswitchb-make-buflist-hook)
1400 (let ((iswitchb-make-buflist-hook 1396 (let ((iswitchb-make-buflist-hook
1401 (lambda () 1397 (lambda ()
1402 (setq iswitchb-temp-buflist 1398 (setq iswitchb-temp-buflist
@@ -1410,16 +1406,14 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1410 (unwind-protect 1406 (unwind-protect
1411 (progn 1407 (progn
1412 (or iswitchb-mode 1408 (or iswitchb-mode
1413 (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)) 1409 (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
1414 (iswitchb-read-buffer prompt def require-match)) 1410 (iswitchb-read-buffer prompt def require-match))
1415 (or iswitchb-mode 1411 (or iswitchb-mode
1416 (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))))) 1412 (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
1417
1418(put 'gnus-parse-without-error 'lisp-indent-function 0)
1419(put 'gnus-parse-without-error 'edebug-form-spec '(body))
1420 1413
1421(defmacro gnus-parse-without-error (&rest body) 1414(defmacro gnus-parse-without-error (&rest body)
1422 "Allow continuing onto the next line even if an error occurs." 1415 "Allow continuing onto the next line even if an error occurs."
1416 (declare (indent 0) (debug (body)))
1423 `(while (not (eobp)) 1417 `(while (not (eobp))
1424 (condition-case () 1418 (condition-case ()
1425 (progn 1419 (progn
@@ -1510,18 +1504,17 @@ Return nil otherwise."
1510 1504
1511(defvar tool-bar-mode) 1505(defvar tool-bar-mode)
1512 1506
1513(defun gnus-tool-bar-update (&rest ignore) 1507(defun gnus-tool-bar-update (&rest _)
1514 "Update the tool bar." 1508 "Update the tool bar."
1515 (when (and (boundp 'tool-bar-mode) 1509 (when (bound-and-true-p tool-bar-mode)
1516 tool-bar-mode)
1517 (let* ((args nil) 1510 (let* ((args nil)
1518 (func (cond ((fboundp 'tool-bar-update) 1511 (func (cond ((fboundp 'tool-bar-update)
1519 'tool-bar-update) 1512 #'tool-bar-update)
1520 ((fboundp 'force-window-update) 1513 ((fboundp 'force-window-update)
1521 'force-window-update) 1514 #'force-window-update)
1522 ((fboundp 'redraw-frame) 1515 ((fboundp 'redraw-frame)
1523 (setq args (list (selected-frame))) 1516 (setq args (list (selected-frame)))
1524 'redraw-frame) 1517 #'redraw-frame)
1525 (t 'ignore)))) 1518 (t 'ignore))))
1526 (apply func args)))) 1519 (apply func args))))
1527 1520
@@ -1536,7 +1529,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1536 (if seqs2_n 1529 (if seqs2_n
1537 (let* ((seqs (cons seq1 seqs2_n)) 1530 (let* ((seqs (cons seq1 seqs2_n))
1538 (cnt 0) 1531 (cnt 0)
1539 (heads (mapcar (lambda (seq) 1532 (heads (mapcar (lambda (_seq)
1540 (make-symbol (concat "head" 1533 (make-symbol (concat "head"
1541 (int-to-string 1534 (int-to-string
1542 (setq cnt (1+ cnt)))))) 1535 (setq cnt (1+ cnt))))))
@@ -1569,8 +1562,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1569 system-configuration) 1562 system-configuration)
1570 ((memq 'type lst) 1563 ((memq 'type lst)
1571 (symbol-name system-type)) 1564 (symbol-name system-type))
1572 (t nil))) 1565 (t nil))))
1573 codename)
1574 (cond 1566 (cond
1575 ((not (memq 'emacs lst)) 1567 ((not (memq 'emacs lst))
1576 nil) 1568 nil)
@@ -1586,9 +1578,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1586empty directories from OLD-PATH." 1578empty directories from OLD-PATH."
1587 (when (file-exists-p old-path) 1579 (when (file-exists-p old-path)
1588 (let* ((old-dir (file-name-directory old-path)) 1580 (let* ((old-dir (file-name-directory old-path))
1589 (old-name (file-name-nondirectory old-path))
1590 (new-dir (file-name-directory new-path)) 1581 (new-dir (file-name-directory new-path))
1591 (new-name (file-name-nondirectory new-path))
1592 temp) 1582 temp)
1593 (gnus-make-directory new-dir) 1583 (gnus-make-directory new-dir)
1594 (rename-file old-path new-path t) 1584 (rename-file old-path new-path t)
@@ -1693,7 +1683,7 @@ lists of strings."
1693 (setq props (plist-put props :foreground (face-foreground face))) 1683 (setq props (plist-put props :foreground (face-foreground face)))
1694 (setq props (plist-put props :background (face-background face)))) 1684 (setq props (plist-put props :background (face-background face))))
1695 (ignore-errors 1685 (ignore-errors
1696 (apply 'create-image file type data-p props)))) 1686 (apply #'create-image file type data-p props))))
1697 1687
1698(defun gnus-put-image (glyph &optional string category) 1688(defun gnus-put-image (glyph &optional string category)
1699 (let ((point (point))) 1689 (let ((point (point)))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 9e52abc1ca7..760bcc2293d 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,4 +1,4 @@
1;;; nnimap.el --- IMAP interface for Gnus 1;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2010-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
4 4
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f036a5a4cbe..949def1bbe7 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -591,7 +591,7 @@ FILE is the file where FUNCTION was probably defined."
591 ;; of the *packages* in which the function is defined. 591 ;; of the *packages* in which the function is defined.
592 (let* ((name (symbol-name symbol)) 592 (let* ((name (symbol-name symbol))
593 (re (concat "\\_<" (regexp-quote name) "\\_>")) 593 (re (concat "\\_<" (regexp-quote name) "\\_>"))
594 (news (directory-files data-directory t "\\`NEWS.[1-9]")) 594 (news (directory-files data-directory t "\\`NEWS"))
595 (place nil) 595 (place nil)
596 (first nil)) 596 (first nil))
597 (with-temp-buffer 597 (with-temp-buffer
@@ -606,7 +606,7 @@ FILE is the file where FUNCTION was probably defined."
606 ;; Almost all entries are of the form "* ... in Emacs NN.MM." 606 ;; Almost all entries are of the form "* ... in Emacs NN.MM."
607 ;; but there are also a few in the form "* Emacs NN.MM is a bug 607 ;; but there are also a few in the form "* Emacs NN.MM is a bug
608 ;; fix release ...". 608 ;; fix release ...".
609 (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)" 609 (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
610 nil t)) 610 nil t))
611 (message "Ref found in non-versioned section in %S" 611 (message "Ref found in non-versioned section in %S"
612 (file-name-nondirectory f)) 612 (file-name-nondirectory f))
@@ -615,8 +615,7 @@ FILE is the file where FUNCTION was probably defined."
615 (setq place (list f pos)) 615 (setq place (list f pos))
616 (setq first version))))))))) 616 (setq first version)))))))))
617 (when first 617 (when first
618 (make-text-button first nil 'type 'help-news 'help-args place)) 618 (make-text-button first nil 'type 'help-news 'help-args place))))
619 first))
620 619
621(add-hook 'help-fns-describe-function-functions 620(add-hook 'help-fns-describe-function-functions
622 #'help-fns--mention-first-release) 621 #'help-fns--mention-first-release)
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f42b594dc46..201efb7f2a7 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1537,7 +1537,7 @@ Return the input string."
1537 (quail-terminate-translation)) 1537 (quail-terminate-translation))
1538 1538
1539(defun quail-update-translation (control-flag) 1539(defun quail-update-translation (control-flag)
1540"Update the current translation status according to CONTROL-FLAG. 1540 "Update the current translation status according to CONTROL-FLAG.
1541If CONTROL-FLAG is integer value, it is the number of keys in the 1541If CONTROL-FLAG is integer value, it is the number of keys in the
1542head `quail-current-key' which can be translated. The remaining keys 1542head `quail-current-key' which can be translated. The remaining keys
1543are put back to `unread-command-events' to be handled again. If 1543are put back to `unread-command-events' to be handled again. If
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 9f603c0c710..3f28144ed6a 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -109,7 +109,7 @@ folder. This is useful for folders that are easily regenerated."
109 (let ((folder mh-current-folder) 109 (let ((folder mh-current-folder)
110 (window-config mh-previous-window-config)) 110 (window-config mh-previous-window-config))
111 (mh-set-folder-modified-p t) ; lock folder to kill it 111 (mh-set-folder-modified-p t) ; lock folder to kill it
112 (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder) 112 (mh-exec-cmd-daemon "rmf" #'mh-rmf-daemon folder)
113 (when (boundp 'mh-speed-folder-map) 113 (when (boundp 'mh-speed-folder-map)
114 (mh-speed-invalidate-map folder)) 114 (mh-speed-invalidate-map folder))
115 (mh-remove-from-sub-folders-cache folder) 115 (mh-remove-from-sub-folders-cache folder)
@@ -123,7 +123,7 @@ folder. This is useful for folders that are easily regenerated."
123 (message "Folder %s removed" folder)) 123 (message "Folder %s removed" folder))
124 (message "Folder not removed"))) 124 (message "Folder not removed")))
125 125
126(defun mh-rmf-daemon (process output) 126(defun mh-rmf-daemon (_process output)
127 "The rmf PROCESS puts OUTPUT in temporary buffer. 127 "The rmf PROCESS puts OUTPUT in temporary buffer.
128Display the results only if something went wrong." 128Display the results only if something went wrong."
129 (set-buffer (get-buffer-create mh-temp-buffer)) 129 (set-buffer (get-buffer-create mh-temp-buffer))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 57702760fbc..0ec2b685d83 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1225,6 +1225,45 @@ scroll the window of possible completions."
1225 (if (eq (car bounds) base) md-at-point 1225 (if (eq (car bounds) base) md-at-point
1226 (completion-metadata (substring string 0 base) table pred)))) 1226 (completion-metadata (substring string 0 base) table pred))))
1227 1227
1228(defun completion-score-sort (completions)
1229 (sort completions
1230 (lambda (x y)
1231 (> (or (get-text-property 0 'completion-score x) 0)
1232 (or (get-text-property 0 'completion-score y) 0)))))
1233
1234(defun completion-sort (all &optional prefer-regular table-sort-fun)
1235 "Sort ALL, which is the list of all the completion strings we found.
1236If PREFER-REGULAR, then give a bit more importance to returning
1237an ordering that is easy to scan quickly (e.g. lexicographic) rather
1238then trying to minimize the expected position of the completion
1239actually desired.
1240TABLE-SORT-FUN is the sorting function specified by the completion table,
1241if applicable.
1242The sort is performed in a destructive way."
1243 (cond
1244 (table-sort-fun
1245 ;; I feel like we should slowly deprecate table-sort-fun (probably
1246 ;; replacing it with a way for the completion table to provide scores),
1247 ;; so let's not try to be clever here.
1248 (funcall table-sort-fun all))
1249 (t
1250 ;; Prefer shorter completions, by default.
1251 (if prefer-regular
1252 (setq all (sort all #'string-lessp))
1253 (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
1254 (if (minibufferp)
1255 ;; Prefer recently used completions and put the default, if
1256 ;; it exists, on top.
1257 (let ((hist (symbol-value minibuffer-history-variable)))
1258 (setq all (sort all
1259 (lambda (c1 c2)
1260 (cond ((equal c1 minibuffer-default) t)
1261 ((equal c2 minibuffer-default) nil)
1262 (t (> (length (member c1 hist))
1263 (length (member c2 hist)))))))))))
1264 (setq all (completion-score-sort all))
1265 all)))
1266
1228(defun completion-all-sorted-completions (&optional start end) 1267(defun completion-all-sorted-completions (&optional start end)
1229 (or completion-all-sorted-completions 1268 (or completion-all-sorted-completions
1230 (let* ((start (or start (minibuffer-prompt-end))) 1269 (let* ((start (or start (minibuffer-prompt-end)))
@@ -1254,23 +1293,7 @@ scroll the window of possible completions."
1254 (setq all (delete-dups all)) 1293 (setq all (delete-dups all))
1255 (setq last (last all)) 1294 (setq last (last all))
1256 1295
1257 (cond 1296 (setq all (completion-sort all nil sort-fun))
1258 (sort-fun
1259 (setq all (funcall sort-fun all)))
1260 (t
1261 ;; Prefer shorter completions, by default.
1262 (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
1263 (if (minibufferp)
1264 ;; Prefer recently used completions and put the default, if
1265 ;; it exists, on top.
1266 (let ((hist (symbol-value minibuffer-history-variable)))
1267 (setq all
1268 (sort all
1269 (lambda (c1 c2)
1270 (cond ((equal c1 minibuffer-default) t)
1271 ((equal c2 minibuffer-default) nil)
1272 (t (> (length (member c1 hist))
1273 (length (member c2 hist))))))))))))
1274 ;; Cache the result. This is not just for speed, but also so that 1297 ;; Cache the result. This is not just for speed, but also so that
1275 ;; repeated calls to minibuffer-force-complete can cycle through 1298 ;; repeated calls to minibuffer-force-complete can cycle through
1276 ;; all possibilities. 1299 ;; all possibilities.
@@ -1887,9 +1910,7 @@ variables.")
1887 ;; not always. 1910 ;; not always.
1888 (let ((sort-fun (completion-metadata-get 1911 (let ((sort-fun (completion-metadata-get
1889 all-md 'display-sort-function))) 1912 all-md 'display-sort-function)))
1890 (if sort-fun 1913 (completion-sort completions 'prefer-regular sort-fun)))
1891 (funcall sort-fun completions)
1892 (sort completions 'string-lessp))))
1893 (when afun 1914 (when afun
1894 (setq completions 1915 (setq completions
1895 (mapcar (lambda (s) 1916 (mapcar (lambda (s)
@@ -2870,7 +2891,9 @@ Return the new suffix."
2870 'point 2891 'point
2871 (substring afterpoint 0 (cdr bounds))))) 2892 (substring afterpoint 0 (cdr bounds)))))
2872 (all (completion-pcm--all-completions prefix pattern table pred))) 2893 (all (completion-pcm--all-completions prefix pattern table pred)))
2873 (completion-hilit-commonality all point (car bounds)))) 2894 (when all
2895 (nconc (completion-pcm--hilit-commonality pattern all)
2896 (car bounds)))))
2874 2897
2875;;; Partial-completion-mode style completion. 2898;;; Partial-completion-mode style completion.
2876 2899
@@ -3033,8 +3056,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
3033 (when (string-match-p regex c) (push c poss))) 3056 (when (string-match-p regex c) (push c poss)))
3034 (nreverse poss)))))) 3057 (nreverse poss))))))
3035 3058
3036(defvar flex-score-match-tightness 100 3059(defvar completion-score-match-tightness 100
3037 "Controls how the `flex' completion style scores its matches. 3060 "Controls how the completion style scores its matches.
3038 3061
3039Value is a positive number. Values smaller than one make the 3062Value is a positive number. Values smaller than one make the
3040scoring formula value matches scattered along the string, while 3063scoring formula value matches scattered along the string, while
@@ -3079,7 +3102,7 @@ latter (which has two).")
3079 ;; For the numerator, we use the number of +, i.e. the 3102 ;; For the numerator, we use the number of +, i.e. the
3080 ;; length of the pattern. For the denominator, it 3103 ;; length of the pattern. For the denominator, it
3081 ;; sums (1+ (/ (grouplen - 1) 3104 ;; sums (1+ (/ (grouplen - 1)
3082 ;; flex-score-match-tightness)) across all groups of 3105 ;; completion-score-match-tightness)) across all groups of
3083 ;; -, sums one to that total, and then multiples by 3106 ;; -, sums one to that total, and then multiples by
3084 ;; the length of the string. 3107 ;; the length of the string.
3085 (score-numerator 0) 3108 (score-numerator 0)
@@ -3095,7 +3118,7 @@ latter (which has two).")
3095 score-denominator (+ score-denominator 3118 score-denominator (+ score-denominator
3096 1 3119 1
3097 (/ (- a last-b 1) 3120 (/ (- a last-b 1)
3098 flex-score-match-tightness 3121 completion-score-match-tightness
3099 1.0)))) 3122 1.0))))
3100 (setq 3123 (setq
3101 last-b b)))) 3124 last-b b))))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 75fc7d62211..7beb61bb643 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
1;;; ldap.el --- client interface to LDAP for Emacs 1;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1998-2019 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
4 4
@@ -419,12 +419,12 @@ RFC2798 Section 9.1.1")
419 (encode-coding-string str ldap-coding-system)) 419 (encode-coding-string str ldap-coding-system))
420 420
421(defun ldap-decode-address (str) 421(defun ldap-decode-address (str)
422 (mapconcat 'ldap-decode-string 422 (mapconcat #'ldap-decode-string
423 (split-string str "\\$") 423 (split-string str "\\$")
424 "\n")) 424 "\n"))
425 425
426(defun ldap-encode-address (str) 426(defun ldap-encode-address (str)
427 (mapconcat 'ldap-encode-string 427 (mapconcat #'ldap-encode-string
428 (split-string str "\n") 428 (split-string str "\n")
429 "$")) 429 "$"))
430 430
@@ -566,9 +566,9 @@ its distinguished name DN.
566The function returns a list of matching entries. Each entry is itself 566The function returns a list of matching entries. Each entry is itself
567an alist of attribute/value pairs." 567an alist of attribute/value pairs."
568 (let* ((buf (get-buffer-create " *ldap-search*")) 568 (let* ((buf (get-buffer-create " *ldap-search*"))
569 (bufval (get-buffer-create " *ldap-value*")) 569 (bufval (get-buffer-create " *ldap-value*"))
570 (host (or (plist-get search-plist 'host) 570 (host (or (plist-get search-plist 'host)
571 ldap-default-host)) 571 ldap-default-host))
572 ;; find entries with port "ldap" that match the requested host if any 572 ;; find entries with port "ldap" that match the requested host if any
573 (asfound (when (plist-get search-plist 'auth-source) 573 (asfound (when (plist-get search-plist 'auth-source)
574 (nth 0 (auth-source-search :host (or host t) 574 (nth 0 (auth-source-search :host (or host t)
@@ -592,59 +592,60 @@ an alist of attribute/value pairs."
592 (base (or (plist-get search-plist 'base) 592 (base (or (plist-get search-plist 'base)
593 (plist-get asfound :base) 593 (plist-get asfound :base)
594 ldap-default-base)) 594 ldap-default-base))
595 (filter (plist-get search-plist 'filter)) 595 (filter (plist-get search-plist 'filter))
596 (attributes (plist-get search-plist 'attributes)) 596 (attributes (plist-get search-plist 'attributes))
597 (attrsonly (plist-get search-plist 'attrsonly)) 597 (attrsonly (plist-get search-plist 'attrsonly))
598 (scope (plist-get search-plist 'scope)) 598 (scope (plist-get search-plist 'scope))
599 (auth (plist-get search-plist 'auth)) 599 (auth (plist-get search-plist 'auth))
600 (deref (plist-get search-plist 'deref)) 600 (deref (plist-get search-plist 'deref))
601 (timelimit (plist-get search-plist 'timelimit)) 601 (timelimit (plist-get search-plist 'timelimit))
602 (sizelimit (plist-get search-plist 'sizelimit)) 602 (sizelimit (plist-get search-plist 'sizelimit))
603 (withdn (plist-get search-plist 'withdn)) 603 (withdn (plist-get search-plist 'withdn))
604 (numres 0) 604 (numres 0)
605 arglist dn name value record result proc) 605 (arglist
606 (append
607 (if (and host
608 (not (equal "" host)))
609 (list (format
610 ;; Use -H if host is a new-style LDAP URI.
611 (if (string-match "\\`[a-zA-Z]+://" host)
612 "-H%s"
613 "-h%s")
614 host)))
615 (if (and attrsonly
616 (not (equal "" attrsonly)))
617 (list "-A"))
618 (if (and base
619 (not (equal "" base)))
620 (list (format "-b%s" base)))
621 (if (and scope
622 (not (equal "" scope)))
623 (list (format "-s%s" scope)))
624 (if (and binddn
625 (not (equal "" binddn)))
626 (list (format "-D%s" binddn)))
627 (if (and auth
628 (equal 'simple auth))
629 (list "-x"))
630 ;; Allow passwd to be set to "", representing a blank password.
631 (if passwd
632 (list "-W"))
633 (if (and deref
634 (not (equal "" deref)))
635 (list (format "-a%s" deref)))
636 (if (and timelimit
637 (not (equal "" timelimit)))
638 (list (format "-l%s" timelimit)))
639 (if (and sizelimit
640 (not (equal "" sizelimit)))
641 (list (format "-z%s" sizelimit)))))
642 dn name value record result)
606 (if (or (null filter) 643 (if (or (null filter)
607 (equal "" filter)) 644 (equal "" filter))
608 (error "No search filter")) 645 (error "No search filter"))
609 (setq filter (cons filter attributes)) 646 (setq filter (cons filter attributes))
610 (with-current-buffer buf 647 (with-current-buffer buf
611 (erase-buffer) 648 (erase-buffer)
612 (if (and host
613 (not (equal "" host)))
614 (setq arglist (nconc arglist
615 (list (format
616 ;; Use -H if host is a new-style LDAP URI.
617 (if (string-match "^[a-zA-Z]+://" host)
618 "-H%s"
619 "-h%s")
620 host)))))
621 (if (and attrsonly
622 (not (equal "" attrsonly)))
623 (setq arglist (nconc arglist (list "-A"))))
624 (if (and base
625 (not (equal "" base)))
626 (setq arglist (nconc arglist (list (format "-b%s" base)))))
627 (if (and scope
628 (not (equal "" scope)))
629 (setq arglist (nconc arglist (list (format "-s%s" scope)))))
630 (if (and binddn
631 (not (equal "" binddn)))
632 (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
633 (if (and auth
634 (equal 'simple auth))
635 (setq arglist (nconc arglist (list "-x"))))
636 ;; Allow passwd to be set to "", representing a blank password.
637 (if passwd
638 (setq arglist (nconc arglist (list "-W"))))
639 (if (and deref
640 (not (equal "" deref)))
641 (setq arglist (nconc arglist (list (format "-a%s" deref)))))
642 (if (and timelimit
643 (not (equal "" timelimit)))
644 (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
645 (if (and sizelimit
646 (not (equal "" sizelimit)))
647 (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
648 (if passwd 649 (if passwd
649 ;; Leave process-connection-type at its default value. See 650 ;; Leave process-connection-type at its default value. See
650 ;; discussion in Bug#33050. 651 ;; discussion in Bug#33050.
@@ -672,7 +673,7 @@ an alist of attribute/value pairs."
672 " bind distinguished name (binddn)")) 673 " bind distinguished name (binddn)"))
673 (error "Failed ldapsearch invocation: %s \"%s\"" 674 (error "Failed ldapsearch invocation: %s \"%s\""
674 ldap-ldapsearch-prog 675 ldap-ldapsearch-prog
675 (mapconcat 'identity proc-args "\" \"")))))) 676 (mapconcat #'identity proc-args "\" \""))))))
676 (apply #'call-process ldap-ldapsearch-prog 677 (apply #'call-process ldap-ldapsearch-prog
677 ;; Ignore stderr, which can corrupt results 678 ;; Ignore stderr, which can corrupt results
678 nil (list buf nil) nil 679 nil (list buf nil) nil
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 24084c828e1..96a7b12c06e 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1871,11 +1871,11 @@ This function does not alter the INPUT string."
1871 (setq global-mode-string 1871 (setq global-mode-string
1872 (append global-mode-string '(rcirc-activity-string)))) 1872 (append global-mode-string '(rcirc-activity-string))))
1873 (add-hook 'window-configuration-change-hook 1873 (add-hook 'window-configuration-change-hook
1874 'rcirc-window-configuration-change)) 1874 #'rcirc-window-configuration-change))
1875 (setq global-mode-string 1875 (setq global-mode-string
1876 (delete 'rcirc-activity-string global-mode-string)) 1876 (delete 'rcirc-activity-string global-mode-string))
1877 (remove-hook 'window-configuration-change-hook 1877 (remove-hook 'window-configuration-change-hook
1878 'rcirc-window-configuration-change))) 1878 #'rcirc-window-configuration-change)))
1879 1879
1880(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist) 1880(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
1881 (setq minor-mode-alist 1881 (setq minor-mode-alist
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index ac706b949ba..f4ca6e77b46 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -334,6 +334,92 @@ terminated by the end of line (i.e., `comment-end' is empty)."
334 (const :tag "EOL-terminated" eol)) 334 (const :tag "EOL-terminated" eol))
335 :group 'comment) 335 :group 'comment)
336 336
337;;;; Setup syntax from "high-level" description of comment syntax
338
339;; This defines `comment-set-syntax' so a major mode can just call
340;; this one function to setup the comment syntax both in the syntax-table
341;; and in the various comment-* variables.
342
343(defvar comment--set-table
344 ;; We want to associate extra properties with syntax-table, but syntax-tables
345 ;; don't have "properties", so we use an eq-hash-table indexed by
346 ;; syntax-tables instead.
347 (make-hash-table :test #'eq))
348
349(defun comment--set-comment-syntax (st comment-list)
350 "Set up comment functionality for generic mode."
351 (let ((chars nil)
352 (comstyles)
353 (comment-start nil))
354
355 ;; Go through all the comments.
356 (pcase-dolist (`(,start ,end . ,props) comment-list)
357 (let ((nested (if (plist-get props :nested) "n"))
358 (comstyle
359 ;; Reuse comstyles if necessary.
360 (or (cdr (assoc start comstyles))
361 (cdr (assoc end comstyles))
362 ;; Otherwise, use a style not yet in use.
363 (if (not (rassoc "" comstyles)) "")
364 (if (not (rassoc "b" comstyles)) "b")
365 "c")))
366 (push (cons start comstyle) comstyles)
367 (push (cons end comstyle) comstyles)
368
369 ;; Setup the syntax table.
370 (if (= (length start) 1)
371 (modify-syntax-entry (aref start 0)
372 (concat "< " comstyle nested) st)
373 (let ((c0 (aref start 0)) (c1 (aref start 1)))
374 ;; Store the relevant info but don't update yet.
375 (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
376 (push (cons c1 (concat (cdr (assoc c1 chars))
377 (concat "2" comstyle)))
378 chars)))
379 (if (= (length end) 1)
380 (modify-syntax-entry (aref end 0)
381 (concat "> " comstyle nested) st)
382 (let ((c0 (aref end 0)) (c1 (aref end 1)))
383 ;; Store the relevant info but don't update yet.
384 (push (cons c0 (concat (cdr (assoc c0 chars))
385 (concat "3" comstyle)))
386 chars)
387 (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
388
389 ;; Process the chars that were part of a 2-char comment marker
390 (with-syntax-table st ;For `char-syntax'.
391 (dolist (cs (nreverse chars))
392 (modify-syntax-entry (car cs)
393 (concat (char-to-string (char-syntax (car cs)))
394 " " (cdr cs))
395 st)))))
396
397(defun comment--set-comment-vars (comment-list)
398 (when comment-list
399 (let ((first (car comment-list)))
400 (setq-local comment-start (car first))
401 (setq-local comment-end
402 (let ((end (cadr first)))
403 (if (string-equal end "\n") "" end))))
404 (unless comment-start-skip ;Don't override manual setup.
405 (setq-local comment-start-skip
406 (concat (regexp-opt (mapcar #'car comment-list))
407 "+[ \t]*")))
408 (unless comment-end-skip ;Don't override manual setup.
409 (setq-local comment-end-skip
410 (concat "[ \t]*"
411 (regexp-opt (mapcar #'cadr comment-list)))))))
412
413(defun comment-set-syntax (st comment-list)
414 (comment--set-comment-syntax st comment-list)
415 (setf (gethash st comment--set-table) comment-list))
416
417(defun comment-get-syntax (&optional st)
418 (unless st (setq st (syntax-table)))
419 (or (gethash st comment--set-table)
420 (let ((parent (char-table-parent st)))
421 (when parent (comment-get-syntax parent)))))
422
337;;;; 423;;;;
338;;;; Helpers 424;;;; Helpers
339;;;; 425;;;;
@@ -358,11 +444,14 @@ functions work correctly. Lisp callers of any other `comment-*'
358function should first call this function explicitly." 444function should first call this function explicitly."
359 (unless (and (not comment-start) noerror) 445 (unless (and (not comment-start) noerror)
360 (unless comment-start 446 (unless comment-start
361 (let ((cs (read-string "No comment syntax is defined. Use: "))) 447 (let ((comment-list (comment-get-syntax)))
362 (if (zerop (length cs)) 448 (if comment-list
363 (error "No comment syntax defined") 449 (comment--set-comment-vars comment-list)
364 (set (make-local-variable 'comment-start) cs) 450 (let ((cs (read-string "No comment syntax is defined. Use: ")))
365 (set (make-local-variable 'comment-start-skip) cs)))) 451 (if (zerop (length cs))
452 (error "No comment syntax defined")
453 (set (make-local-variable 'comment-start) cs)
454 (set (make-local-variable 'comment-start-skip) cs))))))
366 ;; comment-use-syntax 455 ;; comment-use-syntax
367 (when (eq comment-use-syntax 'undecided) 456 (when (eq comment-use-syntax 'undecided)
368 (set (make-local-variable 'comment-use-syntax) 457 (set (make-local-variable 'comment-use-syntax)
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 798475bbc3d..e2bb8adfef5 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -83,10 +83,11 @@ Signal an error if URI is not a valid file URL."
83 (cond ((not scheme) 83 (cond ((not scheme)
84 (unless pattern 84 (unless pattern
85 (rng-uri-error "URI `%s' does not have a scheme" uri))) 85 (rng-uri-error "URI `%s' does not have a scheme" uri)))
86 ((not (string= (downcase scheme) "file")) 86 ((not (member (downcase scheme) '("file" "http")))
87 (rng-uri-error "URI `%s' does not use the `file:' scheme" uri))) 87 (rng-uri-error "URI `%s' does not use the `file:' or `http:' scheme" uri)))
88 (when (not (member authority 88 (when (and (equal (downcase scheme) "file")
89 (cons (system-name) '(nil "" "localhost")))) 89 (not (member authority
90 (cons (system-name) '(nil "" "localhost")))))
90 (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'" 91 (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'"
91 uri)) 92 uri))
92 (when query 93 (when query
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index afa33e064f3..c0bf29a3988 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -439,7 +439,8 @@ and VALUE-END, otherwise a STRING giving the value."
439 (comment 439 (comment
440 (xmltok+ (xmltok-g markup-declaration "!") 440 (xmltok+ (xmltok-g markup-declaration "!")
441 (xmltok-g comment-first-dash "-" 441 (xmltok-g comment-first-dash "-"
442 (xmltok-g comment-open "-") opt) opt)) 442 (xmltok-g comment-open "-") opt)
443 opt))
443 (cdata-section 444 (cdata-section
444 (xmltok+ "!" 445 (xmltok+ "!"
445 (xmltok-g marked-section-open "\\[") 446 (xmltok-g marked-section-open "\\[")
@@ -540,7 +541,9 @@ and VALUE-END, otherwise a STRING giving the value."
540 "%" (xmltok-g param-entity-ref 541 "%" (xmltok-g param-entity-ref
541 ncname 542 ncname
542 (xmltok-g param-entity-ref-close 543 (xmltok-g param-entity-ref-close
543 ";") opt) opt)) 544 ";")
545 opt)
546 opt))
544 (starts-with-nmtoken-not-name 547 (starts-with-nmtoken-not-name
545 (xmltok-g nmtoken 548 (xmltok-g nmtoken
546 (xmltok-p name-continue-not-start-char or ":") 549 (xmltok-p name-continue-not-start-char or ":")
@@ -571,7 +574,8 @@ and VALUE-END, otherwise a STRING giving the value."
571 "!" (xmltok-p (xmltok-g comment-first-dash "-" 574 "!" (xmltok-p (xmltok-g comment-first-dash "-"
572 (xmltok-g comment-open "-") opt) 575 (xmltok-g comment-open "-") opt)
573 or (xmltok-g named-markup-declaration 576 or (xmltok-g named-markup-declaration
574 ncname)) opt)) 577 ncname))
578 opt))
575 (after-lt 579 (after-lt
576 (xmltok+ markup-declaration 580 (xmltok+ markup-declaration
577 or (xmltok-g processing-instruction-question 581 or (xmltok-g processing-instruction-question
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 5aa49b29d6f..6f83d5a579d 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -7430,7 +7430,6 @@ a block. Return a non-nil value when toggling is successful."
7430 (org-defkey map [(right)] 'org-goto-right) 7430 (org-defkey map [(right)] 'org-goto-right)
7431 (org-defkey map [(control ?g)] 'org-goto-quit) 7431 (org-defkey map [(control ?g)] 'org-goto-quit)
7432 (org-defkey map "\C-i" 'org-cycle) 7432 (org-defkey map "\C-i" 'org-cycle)
7433 (org-defkey map [(tab)] 'org-cycle)
7434 (org-defkey map [(down)] 'outline-next-visible-heading) 7433 (org-defkey map [(down)] 'outline-next-visible-heading)
7435 (org-defkey map [(up)] 'outline-previous-visible-heading) 7434 (org-defkey map [(up)] 'outline-previous-visible-heading)
7436 (if org-goto-auto-isearch 7435 (if org-goto-auto-isearch
@@ -12999,8 +12998,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
12999 (and (= c ?q) (not (rassoc c fulltable)))) 12998 (and (= c ?q) (not (rassoc c fulltable))))
13000 (setq quit-flag t)) 12999 (setq quit-flag t))
13001 ((= c ?\ ) nil) 13000 ((= c ?\ ) nil)
13002 ((setq e (rassoc c fulltable) tg (car e)) 13001 ((car (rassoc c fulltable)))
13003 tg)
13004 (t (setq quit-flag t))))))) 13002 (t (setq quit-flag t)))))))
13005 13003
13006(defun org-entry-is-todo-p () 13004(defun org-entry-is-todo-p ()
@@ -15213,11 +15211,11 @@ Returns the new tags string, or nil to not change the current settings."
15213 (setq current (delete tg current)) 15211 (setq current (delete tg current))
15214 (push tg current))) 15212 (push tg current)))
15215 (when exit-after-next (setq exit-after-next 'now))) 15213 (when exit-after-next (setq exit-after-next 'now)))
15216 ((setq e (rassoc c todo-table) tg (car e)) 15214 ((setq tg (car (rassoc c todo-table)))
15217 (with-current-buffer buf 15215 (with-current-buffer buf
15218 (save-excursion (org-todo tg))) 15216 (save-excursion (org-todo tg)))
15219 (when exit-after-next (setq exit-after-next 'now))) 15217 (when exit-after-next (setq exit-after-next 'now)))
15220 ((setq e (rassoc c ntable) tg (car e)) 15218 ((setq tg (car (rassoc c ntable)))
15221 (if (member tg current) 15219 (if (member tg current)
15222 (setq current (delete tg current)) 15220 (setq current (delete tg current))
15223 (cl-loop for g in groups do 15221 (cl-loop for g in groups do
@@ -17616,27 +17614,28 @@ D may be an absolute day number, or a calendar-type list (month day year)."
17616 17614
17617(defun org-diary-sexp-entry (sexp entry d) 17615(defun org-diary-sexp-entry (sexp entry d)
17618 "Process a SEXP diary ENTRY for date D." 17616 "Process a SEXP diary ENTRY for date D."
17617 ;; FIXME: Consolidate with diary-sexp-entry!
17619 (require 'diary-lib) 17618 (require 'diary-lib)
17620 ;; `org-anniversary' and alike expect ENTRY and DATE to be bound 17619 ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
17621 ;; dynamically. 17620 ;; dynamically.
17622 (let* ((sexp `(let ((entry ,entry) 17621 (let* ((user-sexp (car (read-from-string sexp)))
17623 (date ',d)) 17622 (sexp `(let ((entry ,entry) (date ',d)) ,user-sexp))
17624 ,(car (read-from-string sexp))))
17625 (result (if calendar-debug-sexp (eval sexp) 17623 (result (if calendar-debug-sexp (eval sexp)
17626 (condition-case nil 17624 (condition-case err
17627 (eval sexp) 17625 (eval sexp)
17628 (error 17626 (error
17629 (beep) 17627 (beep)
17630 (message "Bad sexp at line %d in %s: %s" 17628 (message "Bad sexp at line %d in %s: %S\nError: %S"
17631 (org-current-line) 17629 (org-current-line)
17632 (buffer-file-name) sexp) 17630 (buffer-file-name) user-sexp err)
17633 (sleep-for 2)))))) 17631 (sleep-for 2))))))
17634 (cond ((stringp result) (split-string result "; ")) 17632 (cond ((stringp result) (split-string result "; "))
17635 ((and (consp result) 17633 ((and (consp result)
17636 (not (consp (cdr result))) 17634 (not (consp (cdr result)))
17637 (stringp (cdr result))) (cdr result)) 17635 (stringp (cdr result)))
17638 ((and (consp result) 17636 (cdr result))
17639 (stringp (car result))) result) 17637 ((and (consp result) (stringp (car result)))
17638 result)
17640 (result entry)))) 17639 (result entry))))
17641 17640
17642(defun org-diary-to-ical-string (frombuf) 17641(defun org-diary-to-ical-string (frombuf)
@@ -23287,7 +23286,7 @@ major mode."
23287 (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) 23286 (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
23288 (open-line 1)) 23287 (open-line 1))
23289 (org-indent-line) 23288 (org-indent-line)
23290 (insert "# "))) 23289 (insert comment-start)))
23291 23290
23292(defvar comment-empty-lines) ; From newcomment.el. 23291(defvar comment-empty-lines) ; From newcomment.el.
23293(defun org-comment-or-uncomment-region (beg end &rest _) 23292(defun org-comment-or-uncomment-region (beg end &rest _)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 401e5aa1da5..73fd9709211 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -30,7 +30,7 @@
30;; To use pcomplete with shell-mode, for example, you will need the 30;; To use pcomplete with shell-mode, for example, you will need the
31;; following in your init file: 31;; following in your init file:
32;; 32;;
33;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup) 33;; (add-hook 'shell-mode-hook #'pcomplete-shell-setup)
34;; 34;;
35;; Most of the code below simply provides support mechanisms for 35;; Most of the code below simply provides support mechanisms for
36;; writing completion functions. Completion functions themselves are 36;; writing completion functions. Completion functions themselves are
@@ -129,31 +129,26 @@
129 129
130(defcustom pcomplete-file-ignore nil 130(defcustom pcomplete-file-ignore nil
131 "A regexp of filenames to be disregarded during file completion." 131 "A regexp of filenames to be disregarded during file completion."
132 :type '(choice regexp (const :tag "None" nil)) 132 :type '(choice regexp (const :tag "None" nil)))
133 :group 'pcomplete)
134 133
135(defcustom pcomplete-dir-ignore nil 134(defcustom pcomplete-dir-ignore nil
136 "A regexp of names to be disregarded during directory completion." 135 "A regexp of names to be disregarded during directory completion."
137 :type '(choice regexp (const :tag "None" nil)) 136 :type '(choice regexp (const :tag "None" nil)))
138 :group 'pcomplete)
139 137
140(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) 138(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
141 ;; FIXME: the doc mentions file-name completion, but the code 139 ;; FIXME: the doc mentions file-name completion, but the code
142 ;; seems to apply it to all completions. 140 ;; seems to apply it to all completions.
143 "If non-nil, ignore case when doing filename completion." 141 "If non-nil, ignore case when doing filename completion."
144 :type 'boolean 142 :type 'boolean)
145 :group 'pcomplete)
146 143
147(defcustom pcomplete-autolist nil 144(defcustom pcomplete-autolist nil
148 "If non-nil, automatically list possibilities on partial completion. 145 "If non-nil, automatically list possibilities on partial completion.
149This mirrors the optional behavior of tcsh." 146This mirrors the optional behavior of tcsh."
150 :type 'boolean 147 :type 'boolean)
151 :group 'pcomplete)
152 148
153(defcustom pcomplete-suffix-list (list ?/ ?:) 149(defcustom pcomplete-suffix-list (list ?/ ?:)
154 "A list of characters which constitute a proper suffix." 150 "A list of characters which constitute a proper suffix."
155 :type '(repeat character) 151 :type '(repeat character))
156 :group 'pcomplete)
157(make-obsolete-variable 'pcomplete-suffix-list nil "24.1") 152(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
158 153
159(defcustom pcomplete-recexact nil 154(defcustom pcomplete-recexact nil
@@ -161,25 +156,22 @@ This mirrors the optional behavior of tcsh."
161This mirrors the optional behavior of tcsh. 156This mirrors the optional behavior of tcsh.
162 157
163A non-nil value is useful if `pcomplete-autolist' is non-nil too." 158A non-nil value is useful if `pcomplete-autolist' is non-nil too."
164 :type 'boolean 159 :type 'boolean)
165 :group 'pcomplete)
166 160
167(define-obsolete-variable-alias 161(define-obsolete-variable-alias
168 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") 162 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
169 163
170(defcustom pcomplete-man-function 'man 164(defcustom pcomplete-man-function #'man
171 "A function to that will be called to display a manual page. 165 "A function to that will be called to display a manual page.
172It will be passed the name of the command to document." 166It will be passed the name of the command to document."
173 :type 'function 167 :type 'function)
174 :group 'pcomplete)
175 168
176(defcustom pcomplete-compare-entry-function 'string-lessp 169(defcustom pcomplete-compare-entry-function #'string-lessp
177 "This function is used to order file entries for completion. 170 "This function is used to order file entries for completion.
178The behavior of most all shells is to sort alphabetically." 171The behavior of most all shells is to sort alphabetically."
179 :type '(radio (function-item string-lessp) 172 :type '(radio (function-item string-lessp)
180 (function-item file-newer-than-file-p) 173 (function-item file-newer-than-file-p)
181 (function :tag "Other")) 174 (function :tag "Other")))
182 :group 'pcomplete)
183 175
184(defcustom pcomplete-help nil 176(defcustom pcomplete-help nil
185 "A string or function (or nil) used for context-sensitive help. 177 "A string or function (or nil) used for context-sensitive help.
@@ -188,8 +180,7 @@ If non-nil, it must a sexp that will be evaluated, and whose
188result will be shown in the minibuffer. 180result will be shown in the minibuffer.
189If nil, the function `pcomplete-man-function' will be called with the 181If nil, the function `pcomplete-man-function' will be called with the
190current command argument." 182current command argument."
191 :type '(choice string sexp (const :tag "Use man page" nil)) 183 :type '(choice string sexp (const :tag "Use man page" nil)))
192 :group 'pcomplete)
193 184
194(defcustom pcomplete-expand-before-complete nil 185(defcustom pcomplete-expand-before-complete nil
195 "If non-nil, expand the current argument before completing it. 186 "If non-nil, expand the current argument before completing it.
@@ -199,11 +190,10 @@ resolved first, and the resultant value that will be completed against
199to be inserted in the buffer. Note that exactly what gets expanded 190to be inserted in the buffer. Note that exactly what gets expanded
200and how is entirely up to the behavior of the 191and how is entirely up to the behavior of the
201`pcomplete-parse-arguments-function'." 192`pcomplete-parse-arguments-function'."
202 :type 'boolean 193 :type 'boolean)
203 :group 'pcomplete)
204 194
205(defcustom pcomplete-parse-arguments-function 195(defcustom pcomplete-parse-arguments-function
206 'pcomplete-parse-buffer-arguments 196 #'pcomplete-parse-buffer-arguments
207 "A function to call to parse the current line's arguments. 197 "A function to call to parse the current line's arguments.
208It should be called with no parameters, and with point at the position 198It should be called with no parameters, and with point at the position
209of the argument that is to be completed. 199of the argument that is to be completed.
@@ -218,8 +208,7 @@ representation of that argument), and BEG-POS gives the beginning
218position of each argument, as it is seen by the user. The establishes 208position of each argument, as it is seen by the user. The establishes
219a relationship between the fully resolved value of the argument, and 209a relationship between the fully resolved value of the argument, and
220the textual representation of the argument." 210the textual representation of the argument."
221 :type 'function 211 :type 'function)
222 :group 'pcomplete)
223 212
224(defcustom pcomplete-cycle-completions t 213(defcustom pcomplete-cycle-completions t
225 "If non-nil, hitting the TAB key cycles through the completion list. 214 "If non-nil, hitting the TAB key cycles through the completion list.
@@ -230,8 +219,7 @@ it acts more like zsh or 4nt, showing the first maximal match first,
230followed by any further matches on each subsequent pressing of the TAB 219followed by any further matches on each subsequent pressing of the TAB
231key. \\[pcomplete-list] is the key to press if the user wants to see 220key. \\[pcomplete-list] is the key to press if the user wants to see
232the list of possible completions." 221the list of possible completions."
233 :type 'boolean 222 :type 'boolean)
234 :group 'pcomplete)
235 223
236(defcustom pcomplete-cycle-cutoff-length 5 224(defcustom pcomplete-cycle-cutoff-length 5
237 "If the number of completions is greater than this, don't cycle. 225 "If the number of completions is greater than this, don't cycle.
@@ -246,8 +234,7 @@ has already entered enough input to disambiguate most of the
246possibilities, and therefore they are probably most interested in 234possibilities, and therefore they are probably most interested in
247cycling through the candidates. Set this value to nil if you want 235cycling through the candidates. Set this value to nil if you want
248cycling to always be enabled." 236cycling to always be enabled."
249 :type '(choice integer (const :tag "Always cycle" nil)) 237 :type '(choice integer (const :tag "Always cycle" nil)))
250 :group 'pcomplete)
251 238
252(defcustom pcomplete-restore-window-delay 1 239(defcustom pcomplete-restore-window-delay 1
253 "The number of seconds to wait before restoring completion windows. 240 "The number of seconds to wait before restoring completion windows.
@@ -258,15 +245,13 @@ displayed will be restored), after this many seconds of idle time. If
258set to nil, completion windows will be left on second until the user 245set to nil, completion windows will be left on second until the user
259removes them manually. If set to 0, they will disappear immediately 246removes them manually. If set to 0, they will disappear immediately
260after the user enters a key other than TAB." 247after the user enters a key other than TAB."
261 :type '(choice integer (const :tag "Never restore" nil)) 248 :type '(choice integer (const :tag "Never restore" nil)))
262 :group 'pcomplete)
263 249
264(defcustom pcomplete-try-first-hook nil 250(defcustom pcomplete-try-first-hook nil
265 "A list of functions which are called before completing an argument. 251 "A list of functions which are called before completing an argument.
266This can be used, for example, for completing things which might apply 252This can be used, for example, for completing things which might apply
267to all arguments, such as variable names after a $." 253to all arguments, such as variable names after a $."
268 :type 'hook 254 :type 'hook)
269 :group 'pcomplete)
270 255
271(defsubst pcomplete-executables (&optional regexp) 256(defsubst pcomplete-executables (&optional regexp)
272 "Complete amongst a list of directories and executables." 257 "Complete amongst a list of directories and executables."
@@ -310,13 +295,11 @@ generate the completions list. This means that the hook
310 (lambda () 295 (lambda ()
311 (pcomplete-here (pcomplete-executables)))) 296 (pcomplete-here (pcomplete-executables))))
312 "Function called for completing the initial command argument." 297 "Function called for completing the initial command argument."
313 :type 'function 298 :type 'function)
314 :group 'pcomplete)
315 299
316(defcustom pcomplete-command-name-function 'pcomplete-command-name 300(defcustom pcomplete-command-name-function #'pcomplete-command-name
317 "Function called for determining the current command name." 301 "Function called for determining the current command name."
318 :type 'function 302 :type 'function)
319 :group 'pcomplete)
320 303
321(defcustom pcomplete-default-completion-function 304(defcustom pcomplete-default-completion-function
322 (function 305 (function
@@ -324,16 +307,14 @@ generate the completions list. This means that the hook
324 (while (pcomplete-here (pcomplete-entries))))) 307 (while (pcomplete-here (pcomplete-entries)))))
325 "Function called when no completion rule can be found. 308 "Function called when no completion rule can be found.
326This function is used to generate completions for every argument." 309This function is used to generate completions for every argument."
327 :type 'function 310 :type 'function)
328 :group 'pcomplete)
329 311
330(defcustom pcomplete-use-paring t 312(defcustom pcomplete-use-paring t
331 "If t, pare alternatives that have already been used. 313 "If t, pare alternatives that have already been used.
332If nil, you will always see the completion set of possible options, no 314If nil, you will always see the completion set of possible options, no
333matter which of those options have already been used in previous 315matter which of those options have already been used in previous
334command arguments." 316command arguments."
335 :type 'boolean 317 :type 'boolean)
336 :group 'pcomplete)
337 318
338(defcustom pcomplete-termination-string " " 319(defcustom pcomplete-termination-string " "
339 "A string that is inserted after any completion or expansion. 320 "A string that is inserted after any completion or expansion.
@@ -342,8 +323,7 @@ words separated by spaces. However, if your list uses a different
342separator character, or if the completion occurs in a word that is 323separator character, or if the completion occurs in a word that is
343already terminated by a character, this variable should be locally 324already terminated by a character, this variable should be locally
344modified to be an empty string, or the desired separation string." 325modified to be an empty string, or the desired separation string."
345 :type 'string 326 :type 'string)
346 :group 'pcomplete)
347 327
348;;; Internal Variables: 328;;; Internal Variables:
349 329
@@ -459,7 +439,7 @@ Same as `pcomplete' but using the standard completion UI."
459 ;; between pcomplete-stub and the buffer's text is simply due to 439 ;; between pcomplete-stub and the buffer's text is simply due to
460 ;; some chars removed by unquoting. Again, this is not 440 ;; some chars removed by unquoting. Again, this is not
461 ;; indispensable but reduces the reliance on c-t-subvert and 441 ;; indispensable but reduces the reliance on c-t-subvert and
462 ;; improves corner case behaviors. 442 ;; improves corner case behaviors. See e.g. bug#34888.
463 (while (progn (setq buftext (pcomplete-unquote-argument 443 (while (progn (setq buftext (pcomplete-unquote-argument
464 (buffer-substring beg (point)))) 444 (buffer-substring beg (point))))
465 (and (> beg argbeg) 445 (and (> beg argbeg)
@@ -501,6 +481,10 @@ Same as `pcomplete' but using the standard completion UI."
501 (setq table (completion-table-case-fold table))) 481 (setq table (completion-table-case-fold table)))
502 (list beg (point) table 482 (list beg (point) table
503 :predicate pred 483 :predicate pred
484 ;; FIXME: This might be useful even if `completions' is nil!
485 :context-help-function
486 (let ((ph pcomplete-help)) ;;Preserve the current value.
487 (lambda () (let ((pcomplete-help ph)) (pcomplete--help))))
504 :exit-function 488 :exit-function
505 ;; If completion is finished, add a terminating space. 489 ;; If completion is finished, add a terminating space.
506 ;; We used to also do this if STATUS is `sole', but 490 ;; We used to also do this if STATUS is `sole', but
@@ -528,6 +512,7 @@ Same as `pcomplete' but using the standard completion UI."
528 "Support extensible programmable completion. 512 "Support extensible programmable completion.
529To use this function, just bind the TAB key to it, or add it to your 513To use this function, just bind the TAB key to it, or add it to your
530completion functions list (it should occur fairly early in the list)." 514completion functions list (it should occur fairly early in the list)."
515 (declare (obsolete "use `completion-at-point' with `pcomplete-completions-at-point' instead" "27.1"))
531 (interactive "p") 516 (interactive "p")
532 (if (and interactively 517 (if (and interactively
533 pcomplete-cycle-completions 518 pcomplete-cycle-completions
@@ -570,6 +555,7 @@ completion functions list (it should occur fairly early in the list)."
570;;;###autoload 555;;;###autoload
571(defun pcomplete-reverse () 556(defun pcomplete-reverse ()
572 "If cycling completion is in use, cycle backwards." 557 "If cycling completion is in use, cycle backwards."
558 (declare (obsolete ?? "27.1"))
573 (interactive) 559 (interactive)
574 (call-interactively 'pcomplete)) 560 (call-interactively 'pcomplete))
575 561
@@ -577,6 +563,7 @@ completion functions list (it should occur fairly early in the list)."
577(defun pcomplete-expand-and-complete () 563(defun pcomplete-expand-and-complete ()
578 "Expand the textual value of the current argument. 564 "Expand the textual value of the current argument.
579This will modify the current buffer." 565This will modify the current buffer."
566 (declare (obsolete "use pcomplete-expand and completion-at-point" "27.1"))
580 (interactive) 567 (interactive)
581 (let ((pcomplete-expand-before-complete t)) 568 (let ((pcomplete-expand-before-complete t))
582 (pcomplete))) 569 (pcomplete)))
@@ -584,6 +571,8 @@ This will modify the current buffer."
584;;;###autoload 571;;;###autoload
585(defun pcomplete-continue () 572(defun pcomplete-continue ()
586 "Complete without reference to any cycling completions." 573 "Complete without reference to any cycling completions."
574 ;; It doesn't seem to be used, so it's OK if we don't have a substitute.
575 (declare (obsolete nil "27.1"))
587 (interactive) 576 (interactive)
588 (setq pcomplete-current-completions nil 577 (setq pcomplete-current-completions nil
589 pcomplete-last-completion-raw nil) 578 pcomplete-last-completion-raw nil)
@@ -594,30 +583,41 @@ This will modify the current buffer."
594 "Expand the textual value of the current argument. 583 "Expand the textual value of the current argument.
595This will modify the current buffer." 584This will modify the current buffer."
596 (interactive) 585 (interactive)
597 (let ((pcomplete-expand-before-complete t) 586 (setq pcomplete-current-completions nil
598 (pcomplete-expand-only-p t)) 587 pcomplete-last-completion-raw nil)
599 (pcomplete) 588 (catch 'pcompleted
600 (when (and pcomplete-current-completions 589 (let* ((pcomplete-stub)
601 (> (length pcomplete-current-completions) 0)) ;?? 590 pcomplete-seen pcomplete-norm-func
602 (delete-char (- pcomplete-last-completion-length)) 591 pcomplete-args pcomplete-last pcomplete-index
603 (while pcomplete-current-completions 592 (pcomplete-autolist pcomplete-autolist)
604 (unless (pcomplete-insert-entry 593 (pcomplete-suffix-list pcomplete-suffix-list)
605 "" (car pcomplete-current-completions) t 594 (pcomplete-expand-only-p t))
606 pcomplete-last-completion-raw) 595 (pcomplete-parse-arguments 'expand-before-complete)))
607 (insert-and-inherit pcomplete-termination-string)) 596 ;; FIXME: What is this doing?
608 (setq pcomplete-current-completions 597 (when (and pcomplete-current-completions
609 (cdr pcomplete-current-completions)))))) 598 (> (length pcomplete-current-completions) 0)) ;??
599 (delete-char (- pcomplete-last-completion-length))
600 (dolist (c (prog1 pcomplete-current-completions
601 (setq pcomplete-current-completions nil)))
602 (unless (pcomplete-insert-entry "" c t
603 pcomplete-last-completion-raw)
604 (insert-and-inherit pcomplete-termination-string)))))
610 605
611;;;###autoload 606;;;###autoload
612(defun pcomplete-help () 607(defun pcomplete-help ()
613 "Display any help information relative to the current argument." 608 "Display any help information relative to the current argument."
614 (interactive) 609 (interactive) ;FIXME!
615 (let ((pcomplete-show-help t)) 610 ;; (declare (obsolete ?? "27.1"))
616 (pcomplete))) 611 (let* ((data (pcomplete-completions-at-point))
612 (helpfun (plist-get (nthcdr 3 data) :context-help-function)))
613 (if helpfun
614 (funcall helpfun)
615 (message "No context-sensitive help available"))))
617 616
618;;;###autoload 617;;;###autoload
619(defun pcomplete-list () 618(defun pcomplete-list ()
620 "Show the list of possible completions for the current argument." 619 "Show the list of possible completions for the current argument."
620 (declare (obsolete completion-help-at-point "27.1"))
621 (interactive) 621 (interactive)
622 (when (and pcomplete-cycle-completions 622 (when (and pcomplete-cycle-completions
623 pcomplete-current-completions 623 pcomplete-current-completions
@@ -751,9 +751,9 @@ COMPLETEF-SYM should be the symbol where the
751dynamic-complete-functions are kept. For comint mode itself, 751dynamic-complete-functions are kept. For comint mode itself,
752this is `comint-dynamic-complete-functions'." 752this is `comint-dynamic-complete-functions'."
753 (set (make-local-variable 'pcomplete-parse-arguments-function) 753 (set (make-local-variable 'pcomplete-parse-arguments-function)
754 'pcomplete-parse-comint-arguments) 754 #'pcomplete-parse-comint-arguments)
755 (add-hook 'completion-at-point-functions 755 (add-hook 'completion-at-point-functions
756 'pcomplete-completions-at-point nil 'local) 756 #'pcomplete-completions-at-point nil 'local)
757 (set (make-local-variable completef-sym) 757 (set (make-local-variable completef-sym)
758 (copy-sequence (symbol-value completef-sym))) 758 (copy-sequence (symbol-value completef-sym)))
759 (let* ((funs (symbol-value completef-sym)) 759 (let* ((funs (symbol-value completef-sym))
@@ -915,12 +915,12 @@ component, `default-directory' is used as the basis for completion."
915 (or (eq action t) 915 (or (eq action t)
916 (eq (car-safe action) 'boundaries)))) 916 (eq (car-safe action) 'boundaries))))
917 (let ((newstring 917 (let ((newstring
918 (mapconcat 'identity (nreverse (cons string strings)) ""))) 918 (mapconcat #'identity (nreverse (cons string strings)) "")))
919 ;; FIXME: We could also try to return unexpanded envvars. 919 ;; FIXME: We could also try to return unexpanded envvars.
920 (complete-with-action action table newstring pred)) 920 (complete-with-action action table newstring pred))
921 (let* ((envpos (apply #'+ (mapcar #' length strings))) 921 (let* ((envpos (apply #'+ (mapcar #' length strings)))
922 (newstring 922 (newstring
923 (mapconcat 'identity (nreverse (cons string strings)) "")) 923 (mapconcat #'identity (nreverse (cons string strings)) ""))
924 (bounds (completion-boundaries newstring table pred 924 (bounds (completion-boundaries newstring table pred
925 (or (cdr-safe action) "")))) 925 (or (cdr-safe action) ""))))
926 (if (>= (car bounds) envpos) 926 (if (>= (car bounds) envpos)
@@ -1181,12 +1181,12 @@ extra checking, and munging of the COMPLETIONS list."
1181 ;; pare it down, if applicable 1181 ;; pare it down, if applicable
1182 (when (and pcomplete-use-paring pcomplete-seen) 1182 (when (and pcomplete-use-paring pcomplete-seen)
1183 (setq pcomplete-seen 1183 (setq pcomplete-seen
1184 (mapcar 'directory-file-name pcomplete-seen)) 1184 (mapcar #'directory-file-name pcomplete-seen))
1185 (dolist (p pcomplete-seen) 1185 (dolist (p pcomplete-seen)
1186 (add-to-list 'pcomplete-seen 1186 (add-to-list 'pcomplete-seen
1187 (funcall pcomplete-norm-func p))) 1187 (funcall pcomplete-norm-func p)))
1188 (setq completions 1188 (setq completions
1189 (apply-partially 'completion-table-with-predicate 1189 (apply-partially #'completion-table-with-predicate
1190 completions 1190 completions
1191 (when pcomplete-seen 1191 (when pcomplete-seen
1192 (lambda (f) 1192 (lambda (f)
@@ -1262,20 +1262,21 @@ See also `pcomplete-filename'."
1262(defun pcomplete--help () 1262(defun pcomplete--help ()
1263 "Produce context-sensitive help for the current argument. 1263 "Produce context-sensitive help for the current argument.
1264If specific documentation can't be given, be generic." 1264If specific documentation can't be given, be generic."
1265 (if (and pcomplete-help 1265 (cond
1266 (or (and (stringp pcomplete-help) 1266 ((functionp pcomplete-help) (funcall pcomplete-help))
1267 (fboundp 'Info-goto-node)) 1267 ((consp pcomplete-help)
1268 (listp pcomplete-help))) 1268 (message "%s" (eval pcomplete-help t)))
1269 (if (listp pcomplete-help) 1269 ((and (stringp pcomplete-help)
1270 (message "%s" (eval pcomplete-help)) 1270 (fboundp 'Info-goto-node))
1271 (save-window-excursion (info)) 1271 (save-window-excursion (info))
1272 (switch-to-buffer-other-window "*info*") 1272 (switch-to-buffer-other-window "*info*")
1273 (funcall (symbol-function 'Info-goto-node) pcomplete-help)) 1273 (Info-goto-node pcomplete-help))
1274 (t
1274 (if pcomplete-man-function 1275 (if pcomplete-man-function
1275 (let ((cmd (funcall pcomplete-command-name-function))) 1276 (let ((cmd (funcall pcomplete-command-name-function)))
1276 (if (and cmd (> (length cmd) 0)) 1277 (if (and cmd (> (length cmd) 0))
1277 (funcall pcomplete-man-function cmd))) 1278 (funcall pcomplete-man-function cmd)))
1278 (message "No context-sensitive help available")))) 1279 (message "No context-sensitive help available")))))
1279 1280
1280;; general utilities 1281;; general utilities
1281 1282
@@ -1292,12 +1293,12 @@ If specific documentation can't be given, be generic."
1292 l) 1293 l)
1293(define-obsolete-function-alias 1294(define-obsolete-function-alias
1294 'pcomplete-uniqify-list 1295 'pcomplete-uniqify-list
1295 'pcomplete-uniquify-list "27.1") 1296 #'pcomplete-uniquify-list "27.1")
1296 1297
1297(defun pcomplete-process-result (cmd &rest args) 1298(defun pcomplete-process-result (cmd &rest args)
1298 "Call CMD using `call-process' and return the simplest result." 1299 "Call CMD using `call-process' and return the simplest result."
1299 (with-temp-buffer 1300 (with-temp-buffer
1300 (apply 'call-process cmd nil t nil args) 1301 (apply #'call-process cmd nil t nil args)
1301 (skip-chars-backward "\n") 1302 (skip-chars-backward "\n")
1302 (buffer-substring (point-min) (point)))) 1303 (buffer-substring (point-min) (point))))
1303 1304
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 5c18879712c..8d6cce690d1 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -525,6 +525,8 @@ preferably use the `c-mode-menu' language constant directly."
525;; and `after-change-functions'. Note that this variable is not set when 525;; and `after-change-functions'. Note that this variable is not set when
526;; `c-before-change' is invoked by a change to text properties. 526;; `c-before-change' is invoked by a change to text properties.
527 527
528(defvar c--use-syntax-propertize t)
529
528(defun c-basic-common-init (mode default-style) 530(defun c-basic-common-init (mode default-style)
529 "Do the necessary initialization for the syntax handling routines 531 "Do the necessary initialization for the syntax handling routines
530and the line breaking/filling code. Intended to be used by other 532and the line breaking/filling code. Intended to be used by other
@@ -669,15 +671,20 @@ that requires a literal mode spec at compile time."
669 671
670 ;; Install the functions that ensure that various internal caches 672 ;; Install the functions that ensure that various internal caches
671 ;; don't become invalid due to buffer changes. 673 ;; don't become invalid due to buffer changes.
672 (when (featurep 'xemacs) 674 (if c--use-syntax-propertize
673 (make-local-hook 'before-change-functions) 675 (setq-local syntax-propertize-function
674 (make-local-hook 'after-change-functions)) 676 (lambda (start end)
675 (add-hook 'before-change-functions 'c-before-change nil t) 677 (c-before-change start (point-max))
676 (setq c-just-done-before-change nil) 678 (c-after-change start end (- end start))))
677 ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10 679 (when (featurep 'xemacs)
678 ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need 680 (make-local-hook 'before-change-functions)
679 ;; c-after-font-lock-init. 681 (make-local-hook 'after-change-functions))
680 (add-hook 'after-change-functions 'c-after-change nil t) 682 (add-hook 'before-change-functions 'c-before-change nil t)
683 (setq c-just-done-before-change nil)
684 ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
685 ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
686 ;; c-after-font-lock-init.
687 (add-hook 'after-change-functions 'c-after-change nil t))
681 (when (boundp 'font-lock-extend-after-change-region-function) 688 (when (boundp 'font-lock-extend-after-change-region-function)
682 (set (make-local-variable 'font-lock-extend-after-change-region-function) 689 (set (make-local-variable 'font-lock-extend-after-change-region-function)
683 'c-extend-after-change-region))) ; Currently (2009-05) used by all 690 'c-extend-after-change-region))) ; Currently (2009-05) used by all
@@ -735,15 +742,17 @@ compatible with old code; callers should always specify it."
735 (widen) 742 (widen)
736 (setq c-new-BEG (point-min)) 743 (setq c-new-BEG (point-min))
737 (setq c-new-END (point-max)) 744 (setq c-new-END (point-max))
738 (save-excursion 745 (unless c--use-syntax-propertize
739 (let (before-change-functions after-change-functions) 746 (save-excursion
740 (mapc (lambda (fn) 747 (let (before-change-functions after-change-functions)
741 (funcall fn (point-min) (point-max))) 748 (mapc (lambda (fn)
742 c-get-state-before-change-functions) 749 (funcall fn (point-min) (point-max)))
743 (mapc (lambda (fn) 750 c-get-state-before-change-functions)
744 (funcall fn (point-min) (point-max) 751 (mapc (lambda (fn)
745 (- (point-max) (point-min)))) 752 (funcall fn (point-min) (point-max)
746 c-before-font-lock-functions)))) 753 (- (point-max) (point-min))))
754 c-before-font-lock-functions)
755 ))))
747 756
748 (set (make-local-variable 'outline-regexp) "[^#\n\^M]") 757 (set (make-local-variable 'outline-regexp) "[^#\n\^M]")
749 (set (make-local-variable 'outline-level) 'c-outline-level) 758 (set (make-local-variable 'outline-level) 'c-outline-level)
@@ -2050,6 +2059,12 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
2050 ;; 2059 ;;
2051 ;; Type a space in the first blank line, and the fontification of the next 2060 ;; Type a space in the first blank line, and the fontification of the next
2052 ;; line was fouled up by context fontification. 2061 ;; line was fouled up by context fontification.
2062 (when c--use-syntax-propertize
2063 ;; This should also update c-new-END and c-new-BEG.
2064 (syntax-propertize end)
2065 ;; FIXME: Apparently `c-new-END' may be left unchanged to a stale value,
2066 ;; presumably when the buffer gets truncated.
2067 (if (> c-new-END (point-max)) (setq c-new-END (point-max))))
2053 (let (new-beg new-end new-region case-fold-search) 2068 (let (new-beg new-end new-region case-fold-search)
2054 (if (and c-in-after-change-fontification 2069 (if (and c-in-after-change-fontification
2055 (< beg c-new-END) (> end c-new-BEG)) 2070 (< beg c-new-END) (> end c-new-BEG))
@@ -2088,7 +2103,8 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
2088(defun c-after-font-lock-init () 2103(defun c-after-font-lock-init ()
2089 ;; Put on `font-lock-mode-hook'. This function ensures our after-change 2104 ;; Put on `font-lock-mode-hook'. This function ensures our after-change
2090 ;; function will get executed before the font-lock one. 2105 ;; function will get executed before the font-lock one.
2091 (when (memq #'c-after-change after-change-functions) 2106 (when (and c--use-syntax-propertize
2107 (memq #'c-after-change after-change-functions))
2092 (remove-hook 'after-change-functions #'c-after-change t) 2108 (remove-hook 'after-change-functions #'c-after-change t)
2093 (add-hook 'after-change-functions #'c-after-change nil t))) 2109 (add-hook 'after-change-functions #'c-after-change nil t)))
2094 2110
@@ -2142,11 +2158,14 @@ This function is called from `c-common-init', once per mode initialization."
2142 (when (eq font-lock-support-mode 'jit-lock-mode) 2158 (when (eq font-lock-support-mode 'jit-lock-mode)
2143 (save-restriction 2159 (save-restriction
2144 (widen) 2160 (widen)
2161 ;; FIXME: This presumes that c-new-BEG and c-new-END have been set
2162 ;; I guess from the before-change-function.
2145 (c-save-buffer-state () ; Protect the undo-list from put-text-property. 2163 (c-save-buffer-state () ; Protect the undo-list from put-text-property.
2146 (if (< c-new-BEG beg) 2164 (if (< c-new-BEG beg)
2147 (put-text-property c-new-BEG beg 'fontified nil)) 2165 (put-text-property c-new-BEG beg 'fontified nil))
2148 (if (> c-new-END end) 2166 (if (> c-new-END end)
2149 (put-text-property end c-new-END 'fontified nil))))) 2167 (put-text-property end (min c-new-END (point-max))
2168 'fontified nil)))))
2150 (cons c-new-BEG c-new-END)) 2169 (cons c-new-BEG c-new-END))
2151 2170
2152;; Emacs < 22 and XEmacs 2171;; Emacs < 22 and XEmacs
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 254269ddf1a..d5ef37a4c02 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -480,8 +480,7 @@ Older version of this page was called `perl5', newer `perl'."
480 :type 'string 480 :type 'string
481 :group 'cperl-help-system) 481 :group 'cperl-help-system)
482 482
483(defcustom cperl-use-syntax-table-text-property 483(defcustom cperl-use-syntax-table-text-property t
484 (boundp 'parse-sexp-lookup-properties)
485 "Non-nil means CPerl sets up and uses `syntax-table' text property." 484 "Non-nil means CPerl sets up and uses `syntax-table' text property."
486 :type 'boolean 485 :type 'boolean
487 :group 'cperl-speed) 486 :group 'cperl-speed)
@@ -700,55 +699,7 @@ install choose-color.el, available from
700 699
701`fill-paragraph' on a comment may leave the point behind the 700`fill-paragraph' on a comment may leave the point behind the
702paragraph. It also triggers a bug in some versions of Emacs (CPerl tries 701paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
703to detect it and bulk out). 702to detect it and bulk out).")
704
705See documentation of a variable `cperl-problems-old-emaxen' for the
706problems which disappear if you upgrade Emacs to a reasonably new
707version (20.3 for Emacs, and those of 2004 for XEmacs).")
708
709(defvar cperl-problems-old-emaxen 'please-ignore-this-line
710 "Description of problems in CPerl mode specific for older Emacs versions.
711
712Emacs had a _very_ restricted syntax parsing engine until version
71320.1. Most problems below are corrected starting from this version of
714Emacs, and all of them should be fixed in version 20.3. (Or apply
715patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in
716this respect (until 2003).
717
718Note that even with newer Emacsen in some very rare cases the details
719of interaction of `font-lock' and syntaxification may be not cleaned
720up yet. You may get slightly different colors basing on the order of
721fontification and syntaxification. Say, the initial faces is correct,
722but editing the buffer breaks this.
723
724Even with older Emacsen CPerl mode tries to corrects some Emacs
725misunderstandings, however, for efficiency reasons the degree of
726correction is different for different operations. The partially
727corrected problems are: POD sections, here-documents, regexps. The
728operations are: highlighting, indentation, electric keywords, electric
729braces.
730
731This may be confusing, since the regexp s#//#/#; may be highlighted
732as a comment, but it will be recognized as a regexp by the indentation
733code. Or the opposite case, when a POD section is highlighted, but
734may break the indentation of the following code (though indentation
735should work if the balance of delimiters is not broken by POD).
736
737The main trick (to make $ a \"backslash\") makes constructions like
738${aaa} look like unbalanced braces. The only trick I can think of is
739to insert it as $ {aaa} (valid in perl5, not in perl4).
740
741Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
742as /($|\\s)/. Note that such a transposition is not always possible.
743
744The solution is to upgrade your Emacs or patch an older one. Note
745that Emacs 20.2 has some bugs related to `syntax-table' text
746properties. Patches are available on the main CPerl download site,
747and on CPAN.
748
749If these bugs cannot be fixed on your machine (say, you have an inferior
750environment and cannot recompile), you may still disable all the fancy stuff
751via `cperl-use-syntax-table-text-property'.")
752 703
753(defvar cperl-praise 'please-ignore-this-line 704(defvar cperl-praise 'please-ignore-this-line
754 "Advantages of CPerl mode. 705 "Advantages of CPerl mode.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4306f5daa02..30c9b813407 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -152,7 +152,8 @@ Used to gray out relevant toolbar icons.")
152 (bound-and-true-p 152 (bound-and-true-p
153 gdb-active-process))))) 153 gdb-active-process)))))
154 ([go] menu-item (if (bound-and-true-p gdb-active-process) 154 ([go] menu-item (if (bound-and-true-p gdb-active-process)
155 "Continue" "Run") gud-go 155 "Continue" "Run")
156 gud-go
156 :visible (and (eq gud-minor-mode 'gdbmi) 157 :visible (and (eq gud-minor-mode 'gdbmi)
157 (gdb-show-run-p))) 158 (gdb-show-run-p)))
158 ([stop] menu-item "Stop" gud-stop-subjob 159 ([stop] menu-item "Stop" gud-stop-subjob
@@ -190,7 +191,8 @@ Used to gray out relevant toolbar icons.")
190 (eq gud-minor-mode 'gdbmi))) 191 (eq gud-minor-mode 'gdbmi)))
191 ([print*] menu-item (if (eq gud-minor-mode 'jdb) 192 ([print*] menu-item (if (eq gud-minor-mode 'jdb)
192 "Dump object" 193 "Dump object"
193 "Print Dereference") gud-pstar 194 "Print Dereference")
195 gud-pstar
194 :enable (not gud-running) 196 :enable (not gud-running)
195 :visible (memq gud-minor-mode '(gdbmi gdb jdb))) 197 :visible (memq gud-minor-mode '(gdbmi gdb jdb)))
196 ([print] menu-item "Print Expression" gud-print 198 ([print] menu-item "Print Expression" gud-print
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index aa412304c59..33c69e168f4 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -33,12 +33,11 @@
33;;; Added by Tom Perrine (TEP) 33;;; Added by Tom Perrine (TEP)
34(defvar m2-mode-syntax-table 34(defvar m2-mode-syntax-table
35 (let ((table (make-syntax-table))) 35 (let ((table (make-syntax-table)))
36 ;; FIXME: nesting!
37 ;; FIXME: `comment-indent' just inserts "(**)" whereas the old code
38 ;; resulted in a nicer "(* *)"!
39 (comment-set-syntax table '(("(*" . "*)") ("//" . "\n")))
36 (modify-syntax-entry ?\\ "\\" table) 40 (modify-syntax-entry ?\\ "\\" table)
37 (modify-syntax-entry ?/ ". 12" table)
38 (modify-syntax-entry ?\n ">" table)
39 (modify-syntax-entry ?\( "()1" table)
40 (modify-syntax-entry ?\) ")(4" table)
41 (modify-syntax-entry ?* ". 23nb" table)
42 (modify-syntax-entry ?+ "." table) 41 (modify-syntax-entry ?+ "." table)
43 (modify-syntax-entry ?- "." table) 42 (modify-syntax-entry ?- "." table)
44 (modify-syntax-entry ?= "." table) 43 (modify-syntax-entry ?= "." table)
@@ -204,10 +203,11 @@
204 (let ((tok (smie-default-backward-token))) 203 (let ((tok (smie-default-backward-token)))
205 (cond 204 (cond
206 ((zerop (length tok)) 205 ((zerop (length tok))
207 (let ((forward-sexp-function nil)) 206 (if (bobp) (setq res ":")
208 (condition-case nil 207 (let ((forward-sexp-function nil))
209 (forward-sexp -1) 208 (condition-case nil
210 (scan-error (setq res ":"))))) 209 (forward-sexp -1)
210 (scan-error (setq res ":"))))))
211 ((member tok '("|" "OF" "..")) (setq res ":-case")) 211 ((member tok '("|" "OF" "..")) (setq res ":-case"))
212 ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE")) 212 ((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
213 (setq res ":"))))) 213 (setq res ":")))))
@@ -311,9 +311,6 @@ followed by the first character of the construct.
311 (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) 311 (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
312 (set (make-local-variable 'paragraph-separate) paragraph-start) 312 (set (make-local-variable 'paragraph-separate) paragraph-start)
313 (set (make-local-variable 'paragraph-ignore-fill-prefix) t) 313 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
314 (set (make-local-variable 'comment-start) "(* ")
315 (set (make-local-variable 'comment-end) " *)")
316 (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
317 (set (make-local-variable 'parse-sexp-ignore-comments) t) 314 (set (make-local-variable 'parse-sexp-ignore-comments) t)
318 (set (make-local-variable 'font-lock-defaults) 315 (set (make-local-variable 'font-lock-defaults)
319 '((m3-font-lock-keywords 316 '((m3-font-lock-keywords
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e1f9a33a691..28d8746ffaf 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -628,7 +628,8 @@ builtins.")
628 ;; OS specific 628 ;; OS specific
629 "VMSError" "WindowsError" 629 "VMSError" "WindowsError"
630 ) 630 )
631 symbol-end) . font-lock-type-face) 631 symbol-end)
632 . font-lock-type-face)
632 ;; assignments 633 ;; assignments
633 ;; support for a = b = c = 5 634 ;; support for a = b = c = 5
634 (,(lambda (limit) 635 (,(lambda (limit)
@@ -678,6 +679,7 @@ Which one will be chosen depends on the value of
678 ((rx (or "\"\"\"" "'''")) 679 ((rx (or "\"\"\"" "'''"))
679 (0 (ignore (python-syntax-stringify)))))) 680 (0 (ignore (python-syntax-stringify))))))
680 681
682;; Always define the alias(es) *before* the variable.
681(define-obsolete-variable-alias 'python--prettify-symbols-alist 683(define-obsolete-variable-alias 'python--prettify-symbols-alist
682 'python-prettify-symbols-alist "26.1") 684 'python-prettify-symbols-alist "26.1")
683 685
diff --git a/lisp/startup.el b/lisp/startup.el
index 7759ed5aed3..2b4f4c7520c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -980,6 +980,13 @@ XDG convention for dotfiles."
980 (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path))) 980 (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
981 found-path)) 981 found-path))
982 982
983(defcustom gc-cons-opportunistic-idle-time 5
984 "Number of seconds before trying an opportunistic GC.
985After this number of seconds of idle time, Emacs tries to collect
986garbage more eagerly (i.e. with thresholds halved) in the hope
987to avoid running the GC later during non-idle time."
988 :type 'integer)
989
983(defun command-line () 990(defun command-line ()
984 "A subroutine of `normal-top-level'. 991 "A subroutine of `normal-top-level'.
985Amongst another things, it parses the command-line arguments." 992Amongst another things, it parses the command-line arguments."
@@ -1377,6 +1384,16 @@ please check its value")
1377 (eq face-ignored-fonts old-face-ignored-fonts)) 1384 (eq face-ignored-fonts old-face-ignored-fonts))
1378 (clear-face-cache))) 1385 (clear-face-cache)))
1379 1386
1387 ;; Start opportunistic GC (after loading the init file, so we obey
1388 ;; its settings). This is desirable for two reason:
1389 ;; - It reduces the number of times we have to GC in the middle of
1390 ;; an operation.
1391 ;; - It means we GC when the C stack is short, reducing the risk of false
1392 ;; positives from the conservative stack scanning.
1393 (when gc-cons-opportunistic-idle-time
1394 (run-with-idle-timer gc-cons-opportunistic-idle-time t
1395 #'garbage-collect-maybe 2))
1396
1380 (setq after-init-time (current-time)) 1397 (setq after-init-time (current-time))
1381 ;; Display any accumulated warnings after all functions in 1398 ;; Display any accumulated warnings after all functions in
1382 ;; `after-init-hook' like `desktop-read' have finalized possible 1399 ;; `after-init-hook' like `desktop-read' have finalized possible
diff --git a/lisp/subr.el b/lisp/subr.el
index baff1e909a1..3f5e1d7a3a4 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -825,11 +825,11 @@ Example:
825 "Return a copy of SEQ with all occurrences of ELT removed. 825 "Return a copy of SEQ with all occurrences of ELT removed.
826SEQ must be a list, vector, or string. The comparison is done with `equal'." 826SEQ must be a list, vector, or string. The comparison is done with `equal'."
827 (declare (side-effect-free t)) 827 (declare (side-effect-free t))
828 (if (nlistp seq) 828 (delete elt (if (nlistp seq)
829 ;; If SEQ isn't a list, there's no need to copy SEQ because 829 ;; If SEQ isn't a list, there's no need to copy SEQ because
830 ;; `delete' will return a new object. 830 ;; `delete' will return a new object.
831 (delete elt seq) 831 seq
832 (delete elt (copy-sequence seq)))) 832 (copy-sequence seq))))
833 833
834(defun remq (elt list) 834(defun remq (elt list)
835 "Return LIST with all occurrences of ELT removed. 835 "Return LIST with all occurrences of ELT removed.
@@ -851,10 +851,10 @@ This is the same format used for saving keyboard macros (see
851`edmacro-mode'). 851`edmacro-mode').
852 852
853For an approximate inverse of this, see `key-description'." 853For an approximate inverse of this, see `key-description'."
854 (declare (pure t))
854 ;; Don't use a defalias, since the `pure' property is only true for 855 ;; Don't use a defalias, since the `pure' property is only true for
855 ;; the calling convention of `kbd'. 856 ;; the calling convention of `kbd'.
856 (read-kbd-macro keys)) 857 (read-kbd-macro keys))
857(put 'kbd 'pure t)
858 858
859(defun undefined () 859(defun undefined ()
860 "Beep to tell the user this binding is undefined." 860 "Beep to tell the user this binding is undefined."
@@ -5586,6 +5586,17 @@ returned list are in the same order as in TREE.
5586(defalias 'flatten-list 'flatten-tree) 5586(defalias 'flatten-list 'flatten-tree)
5587 5587
5588;; The initial anchoring is for better performance in searching matches. 5588;; The initial anchoring is for better performance in searching matches.
5589(defun internal--opportunistic-gc ()
5590 "Run the GC during idle time."
5591 (let ((gc-cons-threshold (/ gc-cons-threshold 2))
5592 ;; FIXME: This doesn't work because it's only consulted at the end
5593 ;; of a GC in order to set the next `gc_relative_threshold'!
5594 (gc-cons-percentage (/ gc-cons-percentage 2)))
5595 ;; HACK ATTACK: the purpose of this dummy call to `eval' is to call
5596 ;; `maybe_gc', so we will trigger a GC if we allocated half of the maximum
5597 ;; allowed before the GC is forced upon us.
5598 (eval 1 t)))
5599
5589(defconst regexp-unmatchable "\\`a\\`" 5600(defconst regexp-unmatchable "\\`a\\`"
5590 "Standard regexp guaranteed not to match any string at all.") 5601 "Standard regexp guaranteed not to match any string at all.")
5591 5602
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index c4b0a8fb6e6..d612217bdb9 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1107,6 +1107,7 @@ versions of xterm."
1107 (t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors))))) 1107 (t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors)))))
1108 ;; Modifying color mappings means realized faces don't use the 1108 ;; Modifying color mappings means realized faces don't use the
1109 ;; right colors, so clear them. 1109 ;; right colors, so clear them.
1110 ;; FIXME: Only for the selected frame!
1110 (clear-face-cache))) 1111 (clear-face-cache)))
1111 1112
1112(defun xterm-maybe-set-dark-background-mode (redc greenc bluec) 1113(defun xterm-maybe-set-dark-background-mode (redc greenc bluec)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 5d5d787945d..19e0039ea53 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1115,7 +1115,7 @@ to exclude some SCSS constructs."
1115 (goto-char start-point) 1115 (goto-char start-point)
1116 (forward-comment (- (point))) 1116 (forward-comment (- (point)))
1117 (skip-chars-backward "@[:alpha:]") 1117 (skip-chars-backward "@[:alpha:]")
1118 (unless (looking-at-p "@\\(mixin\\|include\\)") 1118 (unless (looking-at-p "@\\(?:mixin\\|include\\)")
1119 (cdr color))))) 1119 (cdr color)))))
1120 1120
1121(defun css--compute-color (start-point match) 1121(defun css--compute-color (start-point match)
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index c285491a305..7d951ff16e8 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -900,6 +900,12 @@ region, instead of just filling the current paragraph."
900 (equal hash (buffer-hash))) 900 (equal hash (buffer-hash)))
901 (set-buffer-modified-p nil))))) 901 (set-buffer-modified-p nil)))))
902 902
903(defun unfill-paragraph ()
904 "That thing."
905 (interactive)
906 (let ((fill-column (/ most-positive-fixnum 2)))
907 (fill-paragraph)))
908
903(declare-function comment-search-forward "newcomment" (limit &optional noerror)) 909(declare-function comment-search-forward "newcomment" (limit &optional noerror))
904(declare-function comment-string-strip "newcomment" (str beforep afterp)) 910(declare-function comment-string-strip "newcomment" (str beforep afterp))
905 911
diff --git a/lisp/window.el b/lisp/window.el
index 726d022dfe9..00523d57cd8 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6485,7 +6485,7 @@ pass the elements of (cdr ARGS) as the remaining arguments."
6485 (set-window-dedicated-p window t) 6485 (set-window-dedicated-p window t)
6486 window))))) 6486 window)))))
6487 6487
6488(defcustom special-display-function 'special-display-popup-frame 6488(defcustom special-display-function #'special-display-popup-frame
6489 "Function to call for displaying special buffers. 6489 "Function to call for displaying special buffers.
6490This function is called with two arguments - the buffer and, 6490This function is called with two arguments - the buffer and,
6491optionally, a list - and should return a window displaying that 6491optionally, a list - and should return a window displaying that
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 5ff718292d3..a330604e9bd 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -84,7 +84,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
84 (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) 84 (setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
85 (cond 85 (cond
86 ((null down) 86 ((null down)
87 ;; This is an "up-only" event. Pretend there was an up-event 87 ;; This is an "up-only" event. Pretend there was a down-event
88 ;; right before and keep the up-event for later. 88 ;; right before and keep the up-event for later.
89 (push event unread-command-events) 89 (push event unread-command-events)
90 (vector (cons (intern (replace-regexp-in-string 90 (vector (cons (intern (replace-regexp-in-string
diff --git a/src/alloc.c b/src/alloc.c
index 64aaa8acdfa..86ecf5291c6 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5989,6 +5989,28 @@ garbage_collect (void)
5989 garbage_collect_1 (&gcst); 5989 garbage_collect_1 (&gcst);
5990} 5990}
5991 5991
5992DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe, Sgarbage_collect_maybe, 1, 1, "",
5993 doc: /* Call `garbage-collect' if enough allocation happened.
5994FACTOR determines what "enough" means here:
5995a FACTOR of N means to run the GC if more than 1/Nth of the allocations
5996needed to triger automatic allocation took place. */)
5997 (Lisp_Object factor)
5998{
5999 CHECK_FIXNAT (factor);
6000 EMACS_INT fact = XFIXNAT (factor);
6001 byte_ct new_csgc = consing_since_gc * fact;
6002 if (new_csgc / fact != consing_since_gc)
6003 /* Overflow! */
6004 garbage_collect ();
6005 else
6006 {
6007 consing_since_gc = new_csgc;
6008 maybe_gc ();
6009 consing_since_gc /= fact;
6010 }
6011 return Qnil;
6012}
6013
5992DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", 6014DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
5993 doc: /* Reclaim storage for Lisp objects no longer needed. 6015 doc: /* Reclaim storage for Lisp objects no longer needed.
5994Garbage collection happens automatically if you cons more than 6016Garbage collection happens automatically if you cons more than
@@ -7389,6 +7411,7 @@ N should be nonnegative. */);
7389 defsubr (&Smake_finalizer); 7411 defsubr (&Smake_finalizer);
7390 defsubr (&Spurecopy); 7412 defsubr (&Spurecopy);
7391 defsubr (&Sgarbage_collect); 7413 defsubr (&Sgarbage_collect);
7414 defsubr (&Sgarbage_collect_maybe);
7392 defsubr (&Smemory_info); 7415 defsubr (&Smemory_info);
7393 defsubr (&Smemory_use_counts); 7416 defsubr (&Smemory_use_counts);
7394 defsubr (&Ssuspicious_object); 7417 defsubr (&Ssuspicious_object);
diff --git a/src/keyboard.c b/src/keyboard.c
index 56916e0cb4e..9e1567f8cfe 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2728,7 +2728,7 @@ read_char (int commandflag, Lisp_Object map,
2728 2728
2729 /* If there is still no input available, ask for GC. */ 2729 /* If there is still no input available, ask for GC. */
2730 if (!detect_input_pending_run_timers (0)) 2730 if (!detect_input_pending_run_timers (0))
2731 maybe_gc (); 2731 maybe_gc (); /* FIXME: Why? */
2732 } 2732 }
2733 2733
2734 /* Notify the caller if an autosave hook, or a timer, sentinel or 2734 /* Notify the caller if an autosave hook, or a timer, sentinel or
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 4f1e5729be1..0b67fb3f1f1 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -876,15 +876,6 @@ baz\"\""
876 (call-interactively (key-binding `[,last-command-event]))) 876 (call-interactively (key-binding `[,last-command-event])))
877 (should (equal (buffer-string) "int main () {\n \n}")))) 877 (should (equal (buffer-string) "int main () {\n \n}"))))
878 878
879(define-derived-mode plainer-c-mode c-mode "pC"
880 "A plainer/saner C-mode with no internal electric machinery."
881 (c-toggle-electric-state -1)
882 (setq-local electric-indent-local-mode-hook nil)
883 (setq-local electric-indent-mode-hook nil)
884 (electric-indent-local-mode 1)
885 (dolist (key '(?\" ?\' ?\{ ?\} ?\( ?\) ?\[ ?\]))
886 (local-set-key (vector key) 'self-insert-command)))
887
888(ert-deftest electric-modes-int-main-allman-style () 879(ert-deftest electric-modes-int-main-allman-style ()
889 (ert-with-test-buffer () 880 (ert-with-test-buffer ()
890 (plainer-c-mode) 881 (plainer-c-mode)
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 35df7cc17f1..428b19226b4 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -74,7 +74,7 @@
74 'completion-table-with-predicate 74 'completion-table-with-predicate
75 full-collection no-A nil)))))) 75 full-collection no-A nil))))))
76 76
77(ert-deftest completion-table-subvert-test () 77(ert-deftest completion-table-subvert-test () ;bug#34888
78 (let* ((origtable '("A-hello" "A-there")) 78 (let* ((origtable '("A-hello" "A-there"))
79 (subvtable (completion-table-subvert origtable "B" "A"))) 79 (subvtable (completion-table-subvert origtable "B" "A")))
80 (should (equal (try-completion "B-hel" subvtable) 80 (should (equal (try-completion "B-hel" subvtable)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 525f62a3c0b..c8fe00dd393 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3885,7 +3885,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3885 :tags '(:expensive-test) 3885 :tags '(:expensive-test)
3886 (skip-unless (tramp--test-enabled)) 3886 (skip-unless (tramp--test-enabled))
3887 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p))) 3887 (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
3888 3888 (defvar tramp-display-escape-sequence-regexp) ;Defined in tramp-sh.el
3889 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) 3889 (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
3890 (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) 3890 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
3891 (fnnd (file-name-nondirectory tmp-name)) 3891 (fnnd (file-name-nondirectory tmp-name))