aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-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, 818 insertions, 915 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index 5db74799ade..ffd65c88027 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 . 79) 3 (fill-column . 70)
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 389fb450d86..e75df8b8b61 100644
--- a/.gitignore
+++ b/.gitignore
@@ -251,6 +251,7 @@ gnustmp*
251 251
252# Version control and locks. 252# Version control and locks.
253*.orig 253*.orig
254*.rej
254*.swp 255*.swp
255*~ 256*~
256.#* 257.#*
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 68c8c1259d4..ee2c2091770 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -63,8 +63,7 @@ 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 = --eval '(setq byte-compile-force-lexical-warnings t)' 66BYTE_COMPILE_EXTRA_FLAGS =
67
68# For example to not display the undefined function warnings you can use this: 67# For example to not display the undefined function warnings you can use this:
69# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))' 68# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not unresolved)))'
70# The example above is just for developers, it should not be used by default. 69# The example above is just for developers, it should not be used by default.
@@ -86,7 +85,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
86 85
87# Set load-prefer-newer for the benefit of the non-bootstrappers. 86# Set load-prefer-newer for the benefit of the non-bootstrappers.
88BYTE_COMPILE_FLAGS = \ 87BYTE_COMPILE_FLAGS = \
89 --eval '(setq load-prefer-newer t byte-compile-force-lexical-warnings t)' $(BYTE_COMPILE_EXTRA_FLAGS) 88 --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
90 89
91# Files to compile before others during a bootstrap. This is done to 90# Files to compile before others during a bootstrap. This is done to
92# speed up the bootstrap process. They're ordered by size, so we use 91# speed up the bootstrap process. They're ordered by size, so we use
@@ -317,7 +316,7 @@ compile-targets: $(TARGETS)
317# Compile all the Elisp files that need it. Beware: it approximates 316# Compile all the Elisp files that need it. Beware: it approximates
318# 'no-byte-compile', so watch out for false-positives! 317# 'no-byte-compile', so watch out for false-positives!
319compile-main: gen-lisp compile-clean 318compile-main: gen-lisp compile-clean
320 @(cd $(lisp) && \ 319 @(cd $(lisp) && \
321 els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ 320 els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \
322 for el in ${MAIN_FIRST} $$els; do \ 321 for el in ${MAIN_FIRST} $$els; do \
323 test -f $$el || continue; \ 322 test -f $$el || continue; \
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index f8c82238a31..3d0a843e375 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -648,8 +648,7 @@ 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 ((abbrev-table-p tables) (list tables)) 651 ((vectorp tables) (list tables))
652 (tables (signal 'wrong-type-argument (list 'abbrev-table-p tables)))
653 (t 652 (t
654 (let ((tables (if (listp local-abbrev-table) 653 (let ((tables (if (listp local-abbrev-table)
655 (append local-abbrev-table 654 (append local-abbrev-table
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index f9a420090ee..4ca8515989b 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -31,8 +31,9 @@
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
36(defvar math-emacs-precision 37(defvar math-emacs-precision
37 (let* ((n 1) 38 (let* ((n 1)
38 (x 9) 39 (x 9)
@@ -45,9 +46,9 @@
45 (1- n)) 46 (1- n))
46 "The number of digits in an Emacs float.") 47 "The number of digits in an Emacs float.")
47 48
48;; Find the largest power of 10 which is an Emacs float, 49;;; Find the largest power of 10 which is an Emacs float,
49;; then back off by one so that any float d.dddd...eN 50;;; then back off by one so that any float d.dddd...eN
50;; is an Emacs float, for acceptable d.dddd.... 51;;; is an Emacs float, for acceptable d.dddd....
51 52
52(defvar math-largest-emacs-expt 53(defvar math-largest-emacs-expt
53 (let ((x 1) 54 (let ((x 1)
@@ -366,9 +367,9 @@ If this can't be done, return NIL."
366 (message "Angles measured in radians"))) 367 (message "Angles measured in radians")))
367 368
368 369
369;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] 370;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
370;; This method takes advantage of the fact that Newton's method starting 371;;; This method takes advantage of the fact that Newton's method starting
371;; with an overestimate always works, even using truncating integer division! 372;;; with an overestimate always works, even using truncating integer division!
372(defun math-isqrt (a) 373(defun math-isqrt (a)
373 (cond ((Math-zerop a) a) 374 (cond ((Math-zerop a) a)
374 ((not (natnump a)) 375 ((not (natnump a))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index dad87dc8c97..2c0280ccf3b 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-unless-debug err 159 (condition-case 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 d5450998204..b9c3a21f5ea 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 926fa44c88e..e0d0721f16d 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,4 +1,4 @@
1;;; composite.el --- support character composition -*- lexical-binding:t -*- 1;;; composite.el --- support character composition
2 2
3;; Copyright (C) 2001-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2019 Free Software Foundation, Inc.
4 4
@@ -588,6 +588,7 @@ 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))
591 xoff yoff) 592 xoff yoff)
592 (cond 593 (cond
593 ((and class (>= class 200) (<= class 240)) 594 ((and class (>= class 200) (<= class 240))
@@ -688,7 +689,9 @@ All non-spacing characters have this function in
688 689
689(defun compose-gstring-for-dotted-circle (gstring direction) 690(defun compose-gstring-for-dotted-circle (gstring direction)
690 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle 691 (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
692 (dc-id (lglyph-code dc))
691 (fc (lgstring-glyph gstring 1)) ; glyph of the following char 693 (fc (lgstring-glyph gstring 1)) ; glyph of the following char
694 (fc-id (lglyph-code fc))
692 (gstr (and nil (font-shape-gstring gstring direction)))) 695 (gstr (and nil (font-shape-gstring gstring direction))))
693 (if (and gstr 696 (if (and gstr
694 (or (= (lgstring-glyph-len gstr) 1) 697 (or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 6728525a547..5fb9d751e25 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -551,8 +551,7 @@ 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 (let ((electric-indent--destination (point-marker))) 554 (save-excursion (electric-pair--insert pair)))))
555 (save-excursion (electric-pair--insert pair))))))
556 (_ 555 (_
557 (when (and (if (functionp electric-pair-open-newline-between-pairs) 556 (when (and (if (functionp electric-pair-open-newline-between-pairs)
558 (funcall electric-pair-open-newline-between-pairs) 557 (funcall electric-pair-open-newline-between-pairs)
diff --git a/lisp/electric.el b/lisp/electric.el
index c70e60b720a..53e53bd975c 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -220,14 +220,6 @@ 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
231(defun electric-indent-post-self-insert-function () 223(defun electric-indent-post-self-insert-function ()
232 "Function that `electric-indent-mode' adds to `post-self-insert-hook'. 224 "Function that `electric-indent-mode' adds to `post-self-insert-hook'.
233This indents if the hook `electric-indent-functions' returns non-nil, 225This indents if the hook `electric-indent-functions' returns non-nil,
@@ -269,26 +261,26 @@ or comment."
269 (when at-newline 261 (when at-newline
270 (let ((before (copy-marker (1- pos) t))) 262 (let ((before (copy-marker (1- pos) t)))
271 (save-excursion 263 (save-excursion
272 (unless (electric-indent--inhibited-p) 264 (unless
265 (or (memq indent-line-function
266 electric-indent-functions-without-reindent)
267 electric-indent-inhibit)
273 ;; Don't reindent the previous line if the 268 ;; Don't reindent the previous line if the
274 ;; indentation function is not a real one. 269 ;; indentation function is not a real one.
275 (goto-char before) 270 (goto-char before)
276 (condition-case-unless-debug () 271 (condition-case-unless-debug ()
277 (indent-according-to-mode) 272 (indent-according-to-mode)
278 (error (throw 'indent-error nil)))) 273 (error (throw 'indent-error nil)))
279 ;; The goal here will be to remove the trailing 274 ;; The goal here will be to remove the trailing
280 ;; whitespace after reindentation of the previous line 275 ;; whitespace after reindentation of the previous line
281 ;; because that may have (re)introduced it. 276 ;; because that may have (re)introduced it.
282 (goto-char before) 277 (goto-char before)
283 ;; We were at EOL in marker `before' before the call 278 ;; We were at EOL in marker `before' before the call
284 ;; to `indent-according-to-mode' but after we may 279 ;; to `indent-according-to-mode' but after we may
285 ;; not be (Bug#15767). 280 ;; not be (Bug#15767).
286 (when (and (eolp) 281 (when (and (eolp))
287 ;; Don't delete "trailing space" before point! 282 (delete-horizontal-space t))))))
288 (not (and electric-indent--destination 283 (unless (and electric-indent-inhibit
289 (= (point) electric-indent--destination))))
290 (delete-horizontal-space t)))))
291 (unless (and (electric-indent--inhibited-p)
292 (not at-newline)) 284 (not at-newline))
293 (condition-case-unless-debug () 285 (condition-case-unless-debug ()
294 (indent-according-to-mode) 286 (indent-according-to-mode)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index d8ea33a160d..431525431a4 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 ;; t -> a list of forms, 2984 ;; 'progn or 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,19 +3044,21 @@ 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/nil-> atom, quote or (function atom atom atom) 3047 ;; eval -> atom, quote or (function atom atom atom)
3048 ;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) 3048 ;; progn -> 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 (body tmp) 3050 (let (rest
3051 (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
3052 tmp body)
3051 (cond 3053 (cond
3052 ;; #### This should be split out into byte-compile-nontrivial-function-p. 3054 ;; #### This should be split out into byte-compile-nontrivial-function-p.
3053 ((or (eq output-type 'lambda) 3055 ((or (eq output-type 'lambda)
3054 (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) 3056 (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
3055 (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. 3057 (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
3056 (not (setq tmp (assq 'byte-return byte-compile-output))) 3058 (not (setq tmp (assq 'byte-return byte-compile-output)))
3057 (let ((maycall t) ; t if we may make a funcall. 3059 (progn
3058 (rest (nreverse 3060 (setq rest (nreverse
3059 (cdr (memq tmp (reverse byte-compile-output)))))) 3061 (cdr (memq tmp (reverse byte-compile-output)))))
3060 (while 3062 (while
3061 (cond 3063 (cond
3062 ((memq (car (car rest)) '(byte-varref byte-constant)) 3064 ((memq (car (car rest)) '(byte-varref byte-constant))
@@ -3065,7 +3067,7 @@ for symbols generated by the byte compiler itself."
3065 (or (consp tmp) 3067 (or (consp tmp)
3066 (and (symbolp tmp) 3068 (and (symbolp tmp)
3067 (not (macroexp--const-symbol-p tmp))))) 3069 (not (macroexp--const-symbol-p tmp)))))
3068 (if maycall ;;Why? --Stef 3070 (if maycall
3069 (setq body (cons (list 'quote tmp) body))) 3071 (setq body (cons (list 'quote tmp) body)))
3070 (setq body (cons tmp body)))) 3072 (setq body (cons tmp body))))
3071 ((and maycall 3073 ((and maycall
@@ -3073,7 +3075,7 @@ for symbols generated by the byte compiler itself."
3073 (null (nthcdr 3 rest)) 3075 (null (nthcdr 3 rest))
3074 (setq tmp (get (car (car rest)) 'byte-opcode-invert)) 3076 (setq tmp (get (car (car rest)) 'byte-opcode-invert))
3075 (or (null (cdr rest)) 3077 (or (null (cdr rest))
3076 (and (memq output-type '(file t)) 3078 (and (memq output-type '(file progn t))
3077 (cdr (cdr rest)) 3079 (cdr (cdr rest))
3078 (eq (car (nth 1 rest)) 'byte-discard) 3080 (eq (car (nth 1 rest)) 'byte-discard)
3079 (progn (setq rest (cdr rest)) t)))) 3081 (progn (setq rest (cdr rest)) t))))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 3b6ea12ecff..e4ed745b25d 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -234,13 +234,73 @@ 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 (list start end) normalized))) 237 (push (cons 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
240(defun generic-mode-set-comments (comment-list) 298(defun generic-mode-set-comments (comment-list)
241 "Set up comment functionality for generic mode." 299 "Set up comment functionality for generic mode."
242 (let ((st (make-syntax-table))) 300 (let ((st (make-syntax-table))
243 (comment-set-syntax st comment-list) 301 (comment-list (generic--normalize-comments comment-list)))
302 (generic-set-comment-syntax st comment-list)
303 (generic-set-comment-vars comment-list)
244 (set-syntax-table st))) 304 (set-syntax-table st)))
245 305
246(defun generic-bracket-support () 306(defun generic-bracket-support ()
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index ac47d98359b..fa6dc98d04c 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -237,7 +237,6 @@
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!
241 (let ((sym (intern-soft (match-string 1)))) 240 (let ((sym (intern-soft (match-string 1))))
242 (when (or (special-form-p sym) 241 (when (or (special-form-p sym)
243 (and (macrop sym) 242 (and (macrop sym)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 5b136bdf489..b60a8a136a1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1163,6 +1163,26 @@ 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
1166(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) 1186(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys)
1167 "Access URL and run BODY in a buffer containing the response. 1187 "Access URL and run BODY in a buffer containing the response.
1168Point is after the headers when BODY runs. 1188Point is after the headers when BODY runs.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 07beb722fc3..ae2cf8eb02f 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -97,34 +97,11 @@
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
123(defun pcase--edebug-match-macro (cursor) 100(defun pcase--edebug-match-macro (cursor)
124 (let (specs) 101 (let (specs)
125 (mapatoms 102 (mapatoms
126 (lambda (s) 103 (lambda (s)
127 (let ((m (pcase--get-macroexpander s))) 104 (let ((m (get s 'pcase-macroexpander)))
128 (when (and m (get-edebug-spec m)) 105 (when (and m (get-edebug-spec m))
129 (push (cons (symbol-name s) (get-edebug-spec m)) 106 (push (cons (symbol-name s) (get-edebug-spec m))
130 specs))))) 107 specs)))))
@@ -216,7 +193,7 @@ Emacs Lisp manual for more information and examples."
216 (let (more) 193 (let (more)
217 ;; Collect all the extensions. 194 ;; Collect all the extensions.
218 (mapatoms (lambda (symbol) 195 (mapatoms (lambda (symbol)
219 (let ((me (pcase--get-macroexpander symbol))) 196 (let ((me (get symbol 'pcase-macroexpander)))
220 (when me 197 (when me
221 (push (cons symbol me) 198 (push (cons symbol me)
222 more))))) 199 more)))))
@@ -442,7 +419,7 @@ of the elements of LIST is performed as if by `pcase-let'.
442 ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) 419 ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
443 ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) 420 ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
444 (t 421 (t
445 (let* ((expander (pcase--get-macroexpander head)) 422 (let* ((expander (get head 'pcase-macroexpander))
446 (npat (if expander (apply expander (cdr pat))))) 423 (npat (if expander (apply expander (cdr pat)))))
447 (if (null npat) 424 (if (null npat)
448 (error (if expander 425 (error (if expander
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index a9b5df53c84..00f72e284ad 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 47265962591..f2163b243ee 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 e7c737d85ab..bdb205ce7c8 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 '(?# ?\")) (viper--user-error)) 1077 (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell))
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 (viper--user-error)) 1096 (user-error viper-ViperBell))
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 (viper--user-error)) 1118 (user-error viper-ViperBell))
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 (viper--user-error))))) 1152 (t (user-error viper-ViperBell)))))
1153 1153
1154 (if cmd-to-exec-at-end 1154 (if cmd-to-exec-at-end
1155 (progn 1155 (progn
@@ -1432,25 +1432,23 @@ 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 1435(defvar viper-exec-array (make-vector 128 nil))
1436 (let ((a (make-vector 128 nil)))
1437 1436
1438 ;; Using a dispatch array allows adding functions like buffer search 1437;; Using a dispatch array allows adding functions like buffer search
1439 ;; without affecting other functions. Buffer search can now be bound 1438;; without affecting other functions. Buffer search can now be bound
1440 ;; to any character. 1439;; to any character.
1441 1440
1442 (aset a ?c 'viper-exec-change) 1441(aset viper-exec-array ?c 'viper-exec-change)
1443 (aset a ?C 'viper-exec-Change) 1442(aset viper-exec-array ?C 'viper-exec-Change)
1444 (aset a ?d 'viper-exec-delete) 1443(aset viper-exec-array ?d 'viper-exec-delete)
1445 (aset a ?D 'viper-exec-Delete) 1444(aset viper-exec-array ?D 'viper-exec-Delete)
1446 (aset a ?y 'viper-exec-yank) 1445(aset viper-exec-array ?y 'viper-exec-yank)
1447 (aset a ?Y 'viper-exec-Yank) 1446(aset viper-exec-array ?Y 'viper-exec-Yank)
1448 (aset a ?r 'viper-exec-dummy) 1447(aset viper-exec-array ?r 'viper-exec-dummy)
1449 (aset a ?! 'viper-exec-bang) 1448(aset viper-exec-array ?! 'viper-exec-bang)
1450 (aset a ?< 'viper-exec-shift) 1449(aset viper-exec-array ?< 'viper-exec-shift)
1451 (aset a ?> 'viper-exec-shift) 1450(aset viper-exec-array ?> 'viper-exec-shift)
1452 (aset a ?= 'viper-exec-equals) 1451(aset viper-exec-array ?= 'viper-exec-equals)
1453 a))
1454 1452
1455 1453
1456 1454
@@ -1589,7 +1587,7 @@ invokes the command before that, etc."
1589(defun viper-undo-sentinel (beg end length) 1587(defun viper-undo-sentinel (beg end length)
1590 (run-hook-with-args 'viper-undo-functions beg end length)) 1588 (run-hook-with-args 'viper-undo-functions beg end length))
1591 1589
1592(add-hook 'after-change-functions #'viper-undo-sentinel) 1590(add-hook 'after-change-functions 'viper-undo-sentinel)
1593 1591
1594;; Hook used in viper-undo 1592;; Hook used in viper-undo
1595(defun viper-after-change-undo-hook (beg end _len) 1593(defun viper-after-change-undo-hook (beg end _len)
@@ -1599,7 +1597,7 @@ invokes the command before that, etc."
1599 ;; some other hooks may be changing various text properties in 1597 ;; some other hooks may be changing various text properties in
1600 ;; the buffer in response to 'undo'; so remove this hook to avoid 1598 ;; the buffer in response to 'undo'; so remove this hook to avoid
1601 ;; its repeated invocation 1599 ;; its repeated invocation
1602 (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local) 1600 (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
1603 )) 1601 ))
1604 1602
1605(defun viper-undo () 1603(defun viper-undo ()
@@ -1610,7 +1608,7 @@ invokes the command before that, etc."
1610 undo-beg-posn undo-end-posn) 1608 undo-beg-posn undo-end-posn)
1611 1609
1612 ;; the viper-after-change-undo-hook removes itself after the 1st invocation 1610 ;; the viper-after-change-undo-hook removes itself after the 1st invocation
1613 (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local) 1611 (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)
1614 1612
1615 (undo-start) 1613 (undo-start)
1616 (undo-more 2) 1614 (undo-more 2)
@@ -1882,8 +1880,8 @@ Undo previous insertion and inserts new."
1882;;; Minibuffer business 1880;;; Minibuffer business
1883 1881
1884(defsubst viper-set-minibuffer-style () 1882(defsubst viper-set-minibuffer-style ()
1885 (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel) 1883 (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
1886 (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook)) 1884 (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook))
1887 1885
1888 1886
1889(defun viper-minibuffer-setup-sentinel () 1887(defun viper-minibuffer-setup-sentinel ()
@@ -2229,22 +2227,22 @@ problems."
2229 viper-sitting-in-replace t 2227 viper-sitting-in-replace t
2230 viper-replace-chars-to-delete 0) 2228 viper-replace-chars-to-delete 0)
2231 (add-hook 2229 (add-hook
2232 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local) 2230 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local)
2233 (add-hook 2231 (add-hook
2234 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local) 2232 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local)
2235 ;; this will get added repeatedly, but no harm 2233 ;; this will get added repeatedly, but no harm
2236 (add-hook 'after-change-functions #'viper-after-change-sentinel t) 2234 (add-hook 'after-change-functions 'viper-after-change-sentinel t)
2237 (add-hook 'before-change-functions #'viper-before-change-sentinel t) 2235 (add-hook 'before-change-functions 'viper-before-change-sentinel t)
2238 (viper-move-marker-locally 2236 (viper-move-marker-locally
2239 'viper-last-posn-in-replace-region (viper-replace-start)) 2237 'viper-last-posn-in-replace-region (viper-replace-start))
2240 (add-hook 2238 (add-hook
2241 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 2239 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel
2242 t 'local) 2240 t 'local)
2243 (add-hook 2241 (add-hook
2244 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) 2242 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
2245 ;; guard against a smarty who switched from R-replace to normal replace 2243 ;; guard against a smarty who switched from R-replace to normal replace
2246 (remove-hook 2244 (remove-hook
2247 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) 2245 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
2248 (if overwrite-mode (overwrite-mode -1)) 2246 (if overwrite-mode (overwrite-mode -1))
2249 ) 2247 )
2250 2248
@@ -2318,13 +2316,13 @@ problems."
2318;; Don't delete anything if current point is past the end of the overlay. 2316;; Don't delete anything if current point is past the end of the overlay.
2319(defun viper-finish-change () 2317(defun viper-finish-change ()
2320 (remove-hook 2318 (remove-hook
2321 'viper-after-change-functions #'viper-replace-mode-spy-after 'local) 2319 'viper-after-change-functions 'viper-replace-mode-spy-after 'local)
2322 (remove-hook 2320 (remove-hook
2323 'viper-before-change-functions #'viper-replace-mode-spy-before 'local) 2321 'viper-before-change-functions 'viper-replace-mode-spy-before 'local)
2324 (remove-hook 2322 (remove-hook
2325 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) 2323 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
2326 (remove-hook 2324 (remove-hook
2327 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) 2325 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
2328 (viper-restore-cursor-color 'after-replace-mode) 2326 (viper-restore-cursor-color 'after-replace-mode)
2329 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it 2327 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it
2330 (save-excursion 2328 (save-excursion
@@ -2354,21 +2352,21 @@ problems."
2354 2352
2355(defun viper-finish-R-mode () 2353(defun viper-finish-R-mode ()
2356 (remove-hook 2354 (remove-hook
2357 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local) 2355 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
2358 (remove-hook 2356 (remove-hook
2359 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local) 2357 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
2360 (viper-downgrade-to-insert)) 2358 (viper-downgrade-to-insert))
2361 2359
2362(defun viper-start-R-mode () 2360(defun viper-start-R-mode ()
2363 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number 2361 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
2364 (overwrite-mode 1) 2362 (overwrite-mode 1)
2365 (add-hook 2363 (add-hook
2366 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local) 2364 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local)
2367 (add-hook 2365 (add-hook
2368 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t 'local) 2366 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
2369 ;; guard against a smarty who switched from R-replace to normal replace 2367 ;; guard against a smarty who switched from R-replace to normal replace
2370 (remove-hook 2368 (remove-hook
2371 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel 'local) 2369 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
2372 ) 2370 )
2373 2371
2374 2372
@@ -2543,9 +2541,9 @@ On reaching end of line, stop and signal error."
2543 ;; the forward motion before the 'viper-execute-com', but, of 2541 ;; the forward motion before the 'viper-execute-com', but, of
2544 ;; course, 'dl' doesn't work on an empty line, so we have to 2542 ;; course, 'dl' doesn't work on an empty line, so we have to
2545 ;; catch that condition before 'viper-execute-com' 2543 ;; catch that condition before 'viper-execute-com'
2546 (if (and (eolp) (bolp)) (viper--user-error) (forward-char val)) 2544 (if (and (eolp) (bolp)) (user-error viper-ViperBell) (forward-char val))
2547 (if com (viper-execute-com 'viper-forward-char val com)) 2545 (if com (viper-execute-com 'viper-forward-char val com))
2548 (if (eolp) (progn (backward-char 1) (viper--user-error)))) 2546 (if (eolp) (progn (backward-char 1) (user-error viper-ViperBell))))
2549 (forward-char val) 2547 (forward-char val)
2550 (if com (viper-execute-com 'viper-forward-char val com))))) 2548 (if com (viper-execute-com 'viper-forward-char val com)))))
2551 2549
@@ -2559,7 +2557,7 @@ On reaching beginning of line, stop and signal error."
2559 (if com (viper-move-marker-locally 'viper-com-point (point))) 2557 (if com (viper-move-marker-locally 'viper-com-point (point)))
2560 (if viper-ex-style-motion 2558 (if viper-ex-style-motion
2561 (progn 2559 (progn
2562 (if (bolp) (viper--user-error) (backward-char val)) 2560 (if (bolp) (user-error viper-ViperBell) (backward-char val))
2563 (if com (viper-execute-com 'viper-backward-char val com))) 2561 (if com (viper-execute-com 'viper-backward-char val com)))
2564 (backward-char val) 2562 (backward-char val)
2565 (if com (viper-execute-com 'viper-backward-char val com))))) 2563 (if com (viper-execute-com 'viper-backward-char val com)))))
@@ -2876,7 +2874,7 @@ On reaching beginning of line, stop and signal error."
2876 (if com (viper-execute-com 'viper-goto-col val com)) 2874 (if com (viper-execute-com 'viper-goto-col val com))
2877 (save-excursion 2875 (save-excursion
2878 (end-of-line) 2876 (end-of-line)
2879 (if (> val (current-column)) (viper--user-error))) 2877 (if (> val (current-column)) (user-error viper-ViperBell)))
2880 )) 2878 ))
2881 2879
2882 2880
@@ -3003,7 +3001,7 @@ If point is on a widget or a button, simulate clicking on that widget/button."
3003;; If FORWARD then search is forward, otherwise backward. OFFSET is used to 3001;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
3004;; adjust point after search. 3002;; adjust point after search.
3005(defun viper-find-char (arg char forward offset) 3003(defun viper-find-char (arg char forward offset)
3006 (or (char-or-string-p char) (viper--user-error)) 3004 (or (char-or-string-p char) (user-error viper-ViperBell))
3007 (let ((arg (if forward arg (- arg))) 3005 (let ((arg (if forward arg (- arg)))
3008 (cmd (if (eq viper-intermediate-command 'viper-repeat) 3006 (cmd (if (eq viper-intermediate-command 'viper-repeat)
3009 (nth 5 viper-d-com) 3007 (nth 5 viper-d-com)
@@ -3337,7 +3335,7 @@ controlled by the sign of prefix numeric value."
3337 (if com (viper-move-marker-locally 'viper-com-point (point))) 3335 (if com (viper-move-marker-locally 'viper-com-point (point)))
3338 (backward-sexp 1) 3336 (backward-sexp 1)
3339 (if com (viper-execute-com 'viper-paren-match nil com))) 3337 (if com (viper-execute-com 'viper-paren-match nil com)))
3340 (t (viper--user-error)))))) 3338 (t (user-error viper-ViperBell))))))
3341 3339
3342(defun viper-toggle-parse-sexp-ignore-comments () 3340(defun viper-toggle-parse-sexp-ignore-comments ()
3343 (interactive) 3341 (interactive)
@@ -3908,7 +3906,7 @@ Null string will repeat previous search."
3908 (let ((reg viper-use-register)) 3906 (let ((reg viper-use-register))
3909 (setq viper-use-register nil) 3907 (setq viper-use-register nil)
3910 (error viper-EmptyRegister reg)) 3908 (error viper-EmptyRegister reg))
3911 (viper--user-error))) 3909 (user-error viper-ViperBell)))
3912 (setq viper-use-register nil) 3910 (setq viper-use-register nil)
3913 (if (viper-end-with-a-newline-p text) 3911 (if (viper-end-with-a-newline-p text)
3914 (progn 3912 (progn
@@ -3958,7 +3956,7 @@ Null string will repeat previous search."
3958 (let ((reg viper-use-register)) 3956 (let ((reg viper-use-register))
3959 (setq viper-use-register nil) 3957 (setq viper-use-register nil)
3960 (error viper-EmptyRegister reg)) 3958 (error viper-EmptyRegister reg))
3961 (viper--user-error))) 3959 (user-error viper-ViperBell)))
3962 (setq viper-use-register nil) 3960 (setq viper-use-register nil)
3963 (if (viper-end-with-a-newline-p text) (beginning-of-line)) 3961 (if (viper-end-with-a-newline-p text) (beginning-of-line))
3964 (viper-set-destructive-command 3962 (viper-set-destructive-command
@@ -4003,7 +4001,7 @@ Null string will repeat previous search."
4003 (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4001 (> val (viper-chars-in-region (point) (viper-line-pos 'end))))
4004 (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) 4002 (setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
4005 (if (and viper-ex-style-motion (eolp)) 4003 (if (and viper-ex-style-motion (eolp))
4006 (if (bolp) (viper--user-error) (setq val 0))) ; not bol---simply back 1 ch 4004 (if (bolp) (user-error viper-ViperBell) (setq val 0))) ; not bol---simply back 1 ch
4007 (save-excursion 4005 (save-excursion
4008 (viper-forward-char-carefully val) 4006 (viper-forward-char-carefully val)
4009 (setq end-del-pos (point))) 4007 (setq end-del-pos (point)))
@@ -4273,7 +4271,7 @@ and regexp replace."
4273 ((viper= char ?,) (viper-cycle-through-mark-ring)) 4271 ((viper= char ?,) (viper-cycle-through-mark-ring))
4274 ((viper= char ?^) (push-mark viper-saved-mark t t)) 4272 ((viper= char ?^) (push-mark viper-saved-mark t t))
4275 ((viper= char ?D) (mark-defun)) 4273 ((viper= char ?D) (mark-defun))
4276 (t (viper--user-error)) 4274 (t (user-error viper-ViperBell))
4277 ))) 4275 )))
4278 4276
4279;; Algorithm: If first invocation of this command save mark on ring, goto 4277;; Algorithm: If first invocation of this command save mark on ring, goto
@@ -4372,7 +4370,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
4372 (switch-to-buffer buff) 4370 (switch-to-buffer buff)
4373 (goto-char viper-com-point) 4371 (goto-char viper-com-point)
4374 (viper-change-state-to-vi) 4372 (viper-change-state-to-vi)
4375 (viper--user-error))))) 4373 (user-error viper-ViperBell)))))
4376 ((and (not skip-white) (viper= char ?`)) 4374 ((and (not skip-white) (viper= char ?`))
4377 (if com (viper-move-marker-locally 'viper-com-point (point))) 4375 (if com (viper-move-marker-locally 'viper-com-point (point)))
4378 (if (and (viper-same-line (point) viper-last-jump) 4376 (if (and (viper-same-line (point) viper-last-jump)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 7aa3333f25c..26bca686cb3 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 (viper--user-error))) 1242 (user-error viper-ViperBell)))
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 2af94979278..1d7bb1580ce 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -64,8 +64,6 @@
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"))
69 67
70;; CHAR is supposed to be a char or an integer (positive or negative) 68;; CHAR is supposed to be a char or an integer (positive or negative)
71;; LIST is a list of chars, nil, and negative numbers 69;; 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 bdce91f221f..53a59207839 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,15 +554,14 @@ 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 ;; FIXME: Never added!? 560 (remove-hook 'erc-timer-hook 'erc-user-is-active))
561 (remove-hook 'erc-timer-hook #'erc-user-is-active))
562 (remove-hook 'window-configuration-change-hook 561 (remove-hook 'window-configuration-change-hook
563 #'erc-window-configuration-change) 562 'erc-window-configuration-change)
564 (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update) 563 (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
565 (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels)) 564 (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
566 ;; disable the tracking keybindings 565 ;; disable the tracking keybindings
567 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe) 566 (remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
568 (when erc-track-minor-mode 567 (when erc-track-minor-mode
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 0b0cc044e91..f5c9decc3a2 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)) ;FIXME: Obey the "erc-" prefix convention. 5456 (defvar str))
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 96e95365f5f..fe8eb35d366 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -306,7 +306,8 @@ 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 #'eshell-uniquify-list "27.1") 309 'eshell-uniqify-list
310 'eshell-uniquify-list "27.1")
310 311
311(defun eshell-stringify (object) 312(defun eshell-stringify (object)
312 "Convert OBJECT into a string value." 313 "Convert OBJECT into a string value."
@@ -325,11 +326,11 @@ Prepend remote identification of `default-directory', if any."
325 326
326(defsubst eshell-stringify-list (args) 327(defsubst eshell-stringify-list (args)
327 "Convert each element of ARGS into a string value." 328 "Convert each element of ARGS into a string value."
328 (mapcar #'eshell-stringify args)) 329 (mapcar 'eshell-stringify args))
329 330
330(defsubst eshell-flatten-and-stringify (&rest args) 331(defsubst eshell-flatten-and-stringify (&rest args)
331 "Flatten and stringify all of the ARGS into a single string." 332 "Flatten and stringify all of the ARGS into a single string."
332 (mapconcat #'eshell-stringify (flatten-tree args) " ")) 333 (mapconcat 'eshell-stringify (flatten-tree args) " "))
333 334
334(defsubst eshell-directory-files (regexp &optional directory) 335(defsubst eshell-directory-files (regexp &optional directory)
335 "Return a list of files in the given DIRECTORY matching REGEXP." 336 "Return a list of files in the given DIRECTORY matching REGEXP."
@@ -525,7 +526,7 @@ Unless optional argument INPLACE is non-nil, return a new string."
525 526
526(defsubst eshell-copy-environment () 527(defsubst eshell-copy-environment ()
527 "Return an unrelated copy of `process-environment'." 528 "Return an unrelated copy of `process-environment'."
528 (mapcar #'concat process-environment)) 529 (mapcar 'concat process-environment))
529 530
530(defun eshell-subgroups (groupsym) 531(defun eshell-subgroups (groupsym)
531 "Return all of the subgroups of GROUPSYM." 532 "Return all of the subgroups of GROUPSYM."
diff --git a/lisp/follow.el b/lisp/follow.el
index e570fffdf58..acc2b26c550 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,28 +428,27 @@ 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 431 (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t t)
432 #'follow-align-compilation-windows t t) 432 (add-function :before pre-redisplay-function 'follow-pre-redisplay-function)
433 (add-function :before pre-redisplay-function #'follow-pre-redisplay-function) 433 (add-hook 'window-size-change-functions 'follow-window-size-change t)
434 (add-hook 'window-size-change-functions #'follow-window-size-change t) 434 (add-hook 'after-change-functions 'follow-after-change nil t)
435 (add-hook 'after-change-functions #'follow-after-change nil t) 435 (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t)
436 (add-hook 'isearch-update-post-hook #'follow-post-command-hook nil t) 436 (add-hook 'replace-update-post-hook 'follow-post-command-hook nil t)
437 (add-hook 'replace-update-post-hook #'follow-post-command-hook nil t) 437 (add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t)
438 (add-hook 'ispell-update-post-hook #'follow-post-command-hook nil t)
439 438
440 (when isearch-lazy-highlight 439 (when isearch-lazy-highlight
441 (setq-local isearch-lazy-highlight 'all-windows)) 440 (setq-local isearch-lazy-highlight 'all-windows))
442 (when follow-hide-ghost-cursors 441 (when follow-hide-ghost-cursors
443 (setq-local cursor-in-non-selected-windows nil)) 442 (setq-local cursor-in-non-selected-windows nil))
444 443
445 (setq window-group-start-function #'follow-window-start) 444 (setq window-group-start-function 'follow-window-start)
446 (setq window-group-end-function #'follow-window-end) 445 (setq window-group-end-function 'follow-window-end)
447 (setq set-window-group-start-function #'follow-set-window-start) 446 (setq set-window-group-start-function 'follow-set-window-start)
448 (setq recenter-window-group-function #'follow-recenter) 447 (setq recenter-window-group-function 'follow-recenter)
449 (setq pos-visible-in-window-group-p-function 448 (setq pos-visible-in-window-group-p-function
450 #'follow-pos-visible-in-window-p) 449 'follow-pos-visible-in-window-p)
451 (setq selected-window-group-function #'follow-all-followers) 450 (setq selected-window-group-function 'follow-all-followers)
452 (setq move-to-window-group-line-function #'follow-move-to-window-line)) 451 (setq move-to-window-group-line-function 'follow-move-to-window-line))
453 452
454 ;; Remove globally-installed hook functions only if there is no 453 ;; Remove globally-installed hook functions only if there is no
455 ;; other Follow mode buffer. 454 ;; other Follow mode buffer.
@@ -459,8 +458,8 @@ Keys specific to Follow mode:
459 (setq following (buffer-local-value 'follow-mode (car buffers)) 458 (setq following (buffer-local-value 'follow-mode (car buffers))
460 buffers (cdr buffers))) 459 buffers (cdr buffers)))
461 (unless following 460 (unless following
462 (remove-function pre-redisplay-function #'follow-pre-redisplay-function) 461 (remove-function pre-redisplay-function 'follow-pre-redisplay-function)
463 (remove-hook 'window-size-change-functions #'follow-window-size-change))) 462 (remove-hook 'window-size-change-functions 'follow-window-size-change)))
464 463
465 (kill-local-variable 'move-to-window-group-line-function) 464 (kill-local-variable 'move-to-window-group-line-function)
466 (kill-local-variable 'selected-window-group-function) 465 (kill-local-variable 'selected-window-group-function)
@@ -472,11 +471,11 @@ Keys specific to Follow mode:
472 471
473 (kill-local-variable 'cursor-in-non-selected-windows) 472 (kill-local-variable 'cursor-in-non-selected-windows)
474 473
475 (remove-hook 'ispell-update-post-hook #'follow-post-command-hook t) 474 (remove-hook 'ispell-update-post-hook 'follow-post-command-hook t)
476 (remove-hook 'replace-update-post-hook #'follow-post-command-hook t) 475 (remove-hook 'replace-update-post-hook 'follow-post-command-hook t)
477 (remove-hook 'isearch-update-post-hook #'follow-post-command-hook t) 476 (remove-hook 'isearch-update-post-hook 'follow-post-command-hook t)
478 (remove-hook 'after-change-functions #'follow-after-change t) 477 (remove-hook 'after-change-functions 'follow-after-change t)
479 (remove-hook 'compilation-filter-hook #'follow-align-compilation-windows t))) 478 (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows t)))
480 479
481(defun follow-find-file-hook () 480(defun follow-find-file-hook ()
482 "Find-file hook for Follow mode. See the variable `follow-auto'." 481 "Find-file hook for Follow mode. See the variable `follow-auto'."
@@ -1052,16 +1051,16 @@ returned by `follow-windows-start-end'."
1052(defun follow-select-if-visible (dest win-start-end) 1051(defun follow-select-if-visible (dest win-start-end)
1053 "Select and return a window, if DEST is visible in it. 1052 "Select and return a window, if DEST is visible in it.
1054Return the selected window." 1053Return the selected window."
1055 (let (win) 1054 (let (win wse)
1056 (while (and (not win) win-start-end) 1055 (while (and (not win) win-start-end)
1057 ;; Don't select a window that was just moved. This makes it 1056 ;; Don't select a window that was just moved. This makes it
1058 ;; possible to later select the last window after a 1057 ;; possible to later select the last window after a
1059 ;; `end-of-buffer' command. 1058 ;; `end-of-buffer' command.
1060 (let ((wse (car win-start-end))) 1059 (setq wse (car win-start-end))
1061 (when (follow-pos-visible dest (car wse) win-start-end) 1060 (when (follow-pos-visible dest (car wse) win-start-end)
1062 (setq win (car wse)) 1061 (setq win (car wse))
1063 (select-window win)) 1062 (select-window win))
1064 (setq win-start-end (cdr win-start-end)))) 1063 (setq win-start-end (cdr win-start-end)))
1065 win)) 1064 win))
1066 1065
1067;; Lets select a window showing the end. Make sure we only select it if 1066;; Lets select a window showing the end. Make sure we only select it if
@@ -1218,29 +1217,29 @@ should be a member of WINDOWS, starts at position START."
1218 (setq win (or win (selected-window))) 1217 (setq win (or win (selected-window)))
1219 (setq start (or start (window-start win))) 1218 (setq start (or start (window-start win)))
1220 (save-excursion 1219 (save-excursion
1221 ;; Always calculate what happens when no line is displayed in the first 1220 (let (done win-start res opoint)
1222 ;; window. (The `previous' res is needed below!) 1221 ;; Always calculate what happens when no line is displayed in the first
1223 (goto-char guess) 1222 ;; window. (The `previous' res is needed below!)
1224 (vertical-motion 0 (car windows)) 1223 (goto-char guess)
1225 (let ((res (point)) 1224 (vertical-motion 0 (car windows))
1226 done) 1225 (setq res (point))
1227 (while (not done) 1226 (while (not done)
1228 (let ((opoint (point))) 1227 (setq opoint (point))
1229 (if (not (= (vertical-motion -1 (car windows)) -1)) 1228 (if (not (= (vertical-motion -1 (car windows)) -1))
1230 ;; Hit roof! 1229 ;; Hit roof!
1231 (setq done t res (point-min)) 1230 (setq done t res (point-min))
1232 (let ((win-start (follow-calc-win-start windows (point) win))) 1231 (setq win-start (follow-calc-win-start windows (point) win))
1233 (cond ((>= (point) opoint) 1232 (cond ((>= (point) opoint)
1234 ;; In some pathological cases, vertical-motion may 1233 ;; In some pathological cases, vertical-motion may
1235 ;; return -1 even though point has not decreased. In 1234 ;; return -1 even though point has not decreased. In
1236 ;; that case, avoid looping forever. 1235 ;; that case, avoid looping forever.
1237 (setq done t res (point))) 1236 (setq done t res (point)))
1238 ((= win-start start) ; Perfect match, use this value 1237 ((= win-start start) ; Perfect match, use this value
1239 (setq done t res (point))) 1238 (setq done t res (point)))
1240 ((< win-start start) ; Walked to far, use previous result 1239 ((< win-start start) ; Walked to far, use previous result
1241 (setq done t)) 1240 (setq done t))
1242 (t ; Store result for next iteration 1241 (t ; Store result for next iteration
1243 (setq res (point)))))))) 1242 (setq res (point))))))
1244 res))) 1243 res)))
1245 1244
1246;;; Avoid tail recenter 1245;;; Avoid tail recenter
@@ -1317,8 +1316,6 @@ follow-mode is not necessarily enabled in this buffer.")
1317 ;; Work in the selected window, not in the current buffer. 1316 ;; Work in the selected window, not in the current buffer.
1318 (with-current-buffer (window-buffer win) 1317 (with-current-buffer (window-buffer win)
1319 (unless (and (symbolp this-command) 1318 (unless (and (symbolp this-command)
1320 ;; FIXME: Why not compare buffer-modified-tick and
1321 ;; selected-window to their old value, instead?
1322 (get this-command 'follow-mode-use-cache)) 1319 (get this-command 'follow-mode-use-cache))
1323 (setq follow-windows-start-end-cache nil)) 1320 (setq follow-windows-start-end-cache nil))
1324 (follow-adjust-window win))))) 1321 (follow-adjust-window win)))))
@@ -1326,7 +1323,7 @@ follow-mode is not necessarily enabled in this buffer.")
1326;; NOTE: to debug follow-mode with edebug, it is helpful to add 1323;; NOTE: to debug follow-mode with edebug, it is helpful to add
1327;; `follow-post-command-hook' to `post-command-hook' temporarily. Do 1324;; `follow-post-command-hook' to `post-command-hook' temporarily. Do
1328;; this locally to the target buffer with, say,: 1325;; this locally to the target buffer with, say,:
1329;; M-: (add-hook 'post-command-hook #'follow-post-command-hook t t) 1326;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t)
1330;; . 1327;; .
1331 1328
1332(defun follow-adjust-window (win) 1329(defun follow-adjust-window (win)
@@ -1514,12 +1511,15 @@ follow-mode is not necessarily enabled in this buffer.")
1514 "Make a highlighted region stretching multiple windows look good." 1511 "Make a highlighted region stretching multiple windows look good."
1515 (let* ((all (follow-split-followers windows win)) 1512 (let* ((all (follow-split-followers windows win))
1516 (pred (car all)) 1513 (pred (car all))
1517 (succ (cdr all))) 1514 (succ (cdr all))
1518 (dolist (w pred) 1515 data)
1519 (let ((data (assq w win-start-end))) 1516 (while pred
1520 (set-window-point w (max (nth 1 data) (- (nth 2 data) 1))))) 1517 (setq data (assq (car pred) win-start-end))
1521 (dolist (w succ) 1518 (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
1522 (set-window-point w (nth 1 (assq w win-start-end)))))) 1519 (setq pred (cdr pred)))
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,8 +1690,9 @@ 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))))
1695 (when follow-start-end-invalid 1696 (when follow-start-end-invalid
1696 (follow-redisplay windows (car windows))) 1697 (follow-redisplay windows (car windows)))
1697 (let* ((cache (follow-windows-start-end windows)) 1698 (let* ((cache (follow-windows-start-end windows))
@@ -1702,9 +1703,10 @@ of that row, and VPOS is the row number (zero-based)."
1702 last-elt 1703 last-elt
1703 (setq our-pos (or pos (point))) 1704 (setq our-pos (or pos (point)))
1704 (catch 'element 1705 (catch 'element
1705 (dolist (ce cache) 1706 (while cache
1706 (when (< our-pos (nth 2 ce)) 1707 (when (< our-pos (nth 2 (car cache)))
1707 (throw 'element ce))) 1708 (throw 'element (car cache)))
1709 (setq cache (cdr cache)))
1708 last-elt))) 1710 last-elt)))
1709 (pos-visible-in-window-p our-pos (car pertinent-elt) partially)))) 1711 (pos-visible-in-window-p our-pos (car pertinent-elt) partially))))
1710 1712
@@ -1718,7 +1720,7 @@ zero means top of the first window in the group, negative means
1718 (start-end (follow-windows-start-end windows)) 1720 (start-end (follow-windows-start-end windows))
1719 (rev-start-end (reverse start-end)) 1721 (rev-start-end (reverse start-end))
1720 (lines 0) 1722 (lines 0)
1721 elt count) 1723 middle-window elt count)
1722 (select-window 1724 (select-window
1723 (cond 1725 (cond
1724 ((null arg) 1726 ((null arg)
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index e290a2727d5..4455c594286 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 -*- lexical-binding:t -*- 1;;; format-spec.el --- functions for formatting arbitrary formatting strings
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 87bf058f7fb..9402c15a56b 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -26,7 +26,6 @@
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
30 29
31(cl-defgeneric frame-creation-function (params) 30(cl-defgeneric frame-creation-function (params)
32 "Method for window-system dependent functions to create a new frame. 31 "Method for window-system dependent functions to create a new frame.
@@ -2502,34 +2501,14 @@ command starts, by installing a pre-command hook."
2502 (when (and (> blink-cursor-blinks 0) 2501 (when (and (> blink-cursor-blinks 0)
2503 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done)) 2502 (<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
2504 (blink-cursor-suspend) 2503 (blink-cursor-suspend)
2505 (add-hook 'post-command-hook #'blink-cursor-check)) 2504 (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)))))
2526 2505
2527(defun blink-cursor-end () 2506(defun blink-cursor-end ()
2528 "Stop cursor blinking. 2507 "Stop cursor blinking.
2529This is installed as a pre-command hook by `blink-cursor-start'. 2508This is installed as a pre-command hook by `blink-cursor-start'.
2530When run, it cancels the timer `blink-cursor-timer' and removes 2509When run, it cancels the timer `blink-cursor-timer' and removes
2531itself as a pre-command hook." 2510itself as a pre-command hook."
2532 (remove-hook 'pre-command-hook #'blink-cursor-end) 2511 (remove-hook 'pre-command-hook 'blink-cursor-end)
2533 (internal-show-cursor nil t) 2512 (internal-show-cursor nil t)
2534 (when blink-cursor-timer 2513 (when blink-cursor-timer
2535 (cancel-timer blink-cursor-timer) 2514 (cancel-timer blink-cursor-timer)
@@ -2548,7 +2527,15 @@ frame receives focus."
2548(defun blink-cursor--should-blink () 2527(defun blink-cursor--should-blink ()
2549 "Determine whether we should be blinking. 2528 "Determine whether we should be blinking.
2550Returns whether we have any focused non-TTY frame." 2529Returns whether we have any focused non-TTY frame."
2551 blink-cursor-mode) 2530 (and 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)))
2552 2539
2553(defun blink-cursor-check () 2540(defun blink-cursor-check ()
2554 "Check if cursor blinking shall be restarted. 2541 "Check if cursor blinking shall be restarted.
@@ -2557,7 +2544,7 @@ stopped by `blink-cursor-suspend'. Internally calls
2557`blink-cursor--should-blink' and returns its result." 2544`blink-cursor--should-blink' and returns its result."
2558 (let ((should-blink (blink-cursor--should-blink))) 2545 (let ((should-blink (blink-cursor--should-blink)))
2559 (when (and should-blink (not blink-cursor-idle-timer)) 2546 (when (and should-blink (not blink-cursor-idle-timer))
2560 (remove-hook 'post-command-hook #'blink-cursor-check) 2547 (remove-hook 'post-command-hook 'blink-cursor-check)
2561 (blink-cursor--start-idle-timer)) 2548 (blink-cursor--start-idle-timer))
2562 should-blink)) 2549 should-blink))
2563 2550
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6b5a21eaf55..d826faca5bd 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 (inhibit-read-only t)) 2696 (buffer-read-only nil))
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,67 +4302,71 @@ 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 (defmacro gnus-art-defun (gnus-fun &optional article-fun) 4305 (mapc
4306 "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article buffer." 4306 (lambda (func)
4307 (unless article-fun 4307 (let (afunc gfunc)
4308 (if (not (string-match "\\`gnus-" (symbol-name gnus-fun))) 4308 (if (consp func)
4309 (error "Can't guess article-fun argument") 4309 (setq afunc (car func)
4310 (setq article-fun (intern (substring (symbol-name gnus-fun) 4310 gfunc (cdr func))
4311 (match-end 0)))))) 4311 (setq afunc func
4312 `(defun ,gnus-fun (&optional interactive &rest args) 4312 gfunc (intern (format "gnus-%s" func))))
4313 ,(format "Run `%s' in the article buffer." article-fun) 4313 (defalias gfunc
4314 (interactive (list t)) 4314 (when (fboundp afunc)
4315 (with-current-buffer gnus-article-buffer 4315 `(lambda (&optional interactive &rest args)
4316 (if interactive 4316 ,(documentation afunc t)
4317 (call-interactively ',article-fun) 4317 (interactive (list t))
4318 (apply #',article-fun args)))))) 4318 (with-current-buffer gnus-article-buffer
4319(gnus-art-defun gnus-article-hide-headers) 4319 (if interactive
4320(gnus-art-defun gnus-article-verify-x-pgp-sig) 4320 (call-interactively ',afunc)
4321(gnus-art-defun gnus-article-verify-cancel-lock) 4321 (apply #',afunc args))))))))
4322(gnus-art-defun gnus-article-hide-boring-headers) 4322 '(article-hide-headers
4323(gnus-art-defun gnus-article-treat-overstrike) 4323 article-verify-x-pgp-sig
4324(gnus-art-defun gnus-article-treat-ansi-sequences) 4324 article-verify-cancel-lock
4325(gnus-art-defun gnus-article-fill-long-lines) 4325 article-hide-boring-headers
4326(gnus-art-defun gnus-article-capitalize-sentences) 4326 article-treat-overstrike
4327(gnus-art-defun gnus-article-remove-cr) 4327 article-treat-ansi-sequences
4328(gnus-art-defun gnus-article-remove-leading-whitespace) 4328 article-fill-long-lines
4329(gnus-art-defun gnus-article-display-x-face) 4329 article-capitalize-sentences
4330(gnus-art-defun gnus-article-display-face) 4330 article-remove-cr
4331(gnus-art-defun gnus-article-de-quoted-unreadable) 4331 article-remove-leading-whitespace
4332(gnus-art-defun gnus-article-de-base64-unreadable) 4332 article-display-x-face
4333(gnus-art-defun gnus-article-decode-HZ) 4333 article-display-face
4334(gnus-art-defun gnus-article-wash-html) 4334 article-de-quoted-unreadable
4335(gnus-art-defun gnus-article-unsplit-urls) 4335 article-de-base64-unreadable
4336(gnus-art-defun gnus-article-hide-list-identifiers) 4336 article-decode-HZ
4337(gnus-art-defun gnus-article-strip-banner) 4337 article-wash-html
4338(gnus-art-defun gnus-article-babel) 4338 article-unsplit-urls
4339(gnus-art-defun gnus-article-hide-pem) 4339 article-hide-list-identifiers
4340(gnus-art-defun gnus-article-hide-signature) 4340 article-strip-banner
4341(gnus-art-defun gnus-article-strip-headers-in-body) 4341 article-babel
4342(gnus-art-defun gnus-article-remove-trailing-blank-lines) 4342 article-hide-pem
4343(gnus-art-defun gnus-article-strip-leading-blank-lines) 4343 article-hide-signature
4344(gnus-art-defun gnus-article-strip-multiple-blank-lines) 4344 article-strip-headers-in-body
4345(gnus-art-defun gnus-article-strip-leading-space) 4345 article-remove-trailing-blank-lines
4346(gnus-art-defun gnus-article-strip-trailing-space) 4346 article-strip-leading-blank-lines
4347(gnus-art-defun gnus-article-strip-blank-lines) 4347 article-strip-multiple-blank-lines
4348(gnus-art-defun gnus-article-strip-all-blank-lines) 4348 article-strip-leading-space
4349(gnus-art-defun gnus-article-date-local) 4349 article-strip-trailing-space
4350(gnus-art-defun gnus-article-date-english) 4350 article-strip-blank-lines
4351(gnus-art-defun gnus-article-date-iso8601) 4351 article-strip-all-blank-lines
4352(gnus-art-defun gnus-article-date-original) 4352 article-date-local
4353(gnus-art-defun gnus-article-treat-date) 4353 article-date-english
4354(gnus-art-defun gnus-article-date-ut) 4354 article-date-iso8601
4355(gnus-art-defun gnus-article-decode-mime-words) 4355 article-date-original
4356(gnus-art-defun gnus-article-decode-charset) 4356 article-treat-date
4357(gnus-art-defun gnus-article-decode-encoded-words) 4357 article-date-ut
4358(gnus-art-defun gnus-article-date-user) 4358 article-decode-mime-words
4359(gnus-art-defun gnus-article-date-lapsed) 4359 article-decode-charset
4360(gnus-art-defun gnus-article-date-combined-lapsed) 4360 article-decode-encoded-words
4361(gnus-art-defun gnus-article-emphasize) 4361 article-date-user
4362(gnus-art-defun gnus-article-treat-dumbquotes) 4362 article-date-lapsed
4363(gnus-art-defun gnus-article-treat-non-ascii) 4363 article-date-combined-lapsed
4364(gnus-art-defun gnus-article-normalize-headers) 4364 article-emphasize
4365;;(gnus-art-defun gnus-article-show-all-headers article-show-all) 4365 article-treat-dumbquotes
4366 article-treat-non-ascii
4367 article-normalize-headers
4368 ;;(article-show-all . gnus-article-show-all-headers)
4369 )))
4366 4370
4367;;; 4371;;;
4368;;; Gnus article mode 4372;;; Gnus article mode
@@ -4865,19 +4869,18 @@ General format specifiers can also be used. See Info node
4865(defvar gnus-mime-button-map 4869(defvar gnus-mime-button-map
4866 (let ((map (make-sparse-keymap))) 4870 (let ((map (make-sparse-keymap)))
4867 (define-key map [mouse-2] 'gnus-article-push-button) 4871 (define-key map [mouse-2] 'gnus-article-push-button)
4872 (define-key map [down-mouse-3] 'gnus-mime-button-menu)
4868 (dolist (c gnus-mime-button-commands) 4873 (dolist (c gnus-mime-button-commands)
4869 (define-key map (cadr c) (car c))) 4874 (define-key map (cadr c) (car c)))
4870
4871 (easy-menu-define gnus-mime-button-menu map "MIME button menu."
4872 `("MIME Part"
4873 ,@(mapcar (lambda (c)
4874 (vector (caddr c) (car c) :active t))
4875 gnus-mime-button-commands)))
4876
4877 (define-key map [down-mouse-3]
4878 (easy-menu-binding gnus-mime-button-menu))
4879 map)) 4875 map))
4880 4876
4877(easy-menu-define
4878 gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
4879 `("MIME Part"
4880 ,@(mapcar (lambda (c)
4881 (vector (caddr c) (car c) :active t))
4882 gnus-mime-button-commands)))
4883
4881(defvar gnus-url-button-commands 4884(defvar gnus-url-button-commands
4882 '((gnus-article-copy-string "u" "Copy URL to kill ring"))) 4885 '((gnus-article-copy-string "u" "Copy URL to kill ring")))
4883 4886
@@ -4920,6 +4923,16 @@ General format specifiers can also be used. See Info node
4920 (setq mm-w3m-safe-url-regexp nil))) 4923 (setq mm-w3m-safe-url-regexp nil)))
4921 ,@body)) 4924 ,@body))
4922 4925
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
4923(defun gnus-mime-view-all-parts (&optional handles) 4936(defun gnus-mime-view-all-parts (&optional handles)
4924 "View all the MIME parts." 4937 "View all the MIME parts."
4925 (interactive) 4938 (interactive)
@@ -5042,12 +5055,10 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
5042 nil nil))) 5055 nil nil)))
5043 (gnus-mime-save-part-and-strip file)) 5056 (gnus-mime-save-part-and-strip file))
5044 5057
5045(defun gnus-mime-save-part-and-strip (&optional file event) 5058(defun gnus-mime-save-part-and-strip (&optional file)
5046 "Save the MIME part under point then replace it with an external body. 5059 "Save the MIME part under point then replace it with an external body.
5047If FILE is given, use it for the external part." 5060If FILE is given, use it for the external part."
5048 (interactive (list nil last-nonmenu-event)) 5061 (interactive)
5049 (save-excursion
5050 (mouse-set-point event)
5051 (gnus-article-check-buffer) 5062 (gnus-article-check-buffer)
5052 (when (gnus-group-read-only-p) 5063 (when (gnus-group-read-only-p)
5053 (error "The current group does not support deleting of parts")) 5064 (error "The current group does not support deleting of parts"))
@@ -5079,16 +5090,15 @@ The current article has a complicated MIME structure, giving up..."))
5079 (access-type . "LOCAL-FILE") 5090 (access-type . "LOCAL-FILE")
5080 (name . ,file))))) 5091 (name . ,file)))))
5081 ;; (set-buffer gnus-summary-buffer) 5092 ;; (set-buffer gnus-summary-buffer)
5082 (gnus-article-edit-part handles id))))) 5093 (gnus-article-edit-part handles id))))
5083 5094
5084;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all 5095;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
5085;; parts...>') but with stripping would be nice. 5096;; parts...>') but with stripping would be nice.
5086 5097
5087(defun gnus-mime-delete-part (&optional event) 5098(defun gnus-mime-delete-part ()
5088 "Delete the MIME part under point. 5099 "Delete the MIME part under point.
5089Replace it with some information about the removed part." 5100Replace it with some information about the removed part."
5090 (interactive (list last-nonmenu-event)) 5101 (interactive)
5091 (mouse-set-point event)
5092 (gnus-article-check-buffer) 5102 (gnus-article-check-buffer)
5093 (when (gnus-group-read-only-p) 5103 (when (gnus-group-read-only-p)
5094 (error "The current group does not support deleting of parts")) 5104 (error "The current group does not support deleting of parts"))
@@ -5134,36 +5144,33 @@ Deleting parts may malfunction or destroy the article; continue? "))
5134 ;; (set-buffer gnus-summary-buffer) 5144 ;; (set-buffer gnus-summary-buffer)
5135 (gnus-article-edit-part handles id)))) 5145 (gnus-article-edit-part handles id))))
5136 5146
5137(defun gnus-mime-save-part (&optional event) 5147(defun gnus-mime-save-part ()
5138 "Save the MIME part under point." 5148 "Save the MIME part under point."
5139 (interactive (list last-nonmenu-event)) 5149 (interactive)
5140 (mouse-set-point event)
5141 (gnus-article-check-buffer) 5150 (gnus-article-check-buffer)
5142 (let ((data (get-text-property (point) 'gnus-data))) 5151 (let ((data (get-text-property (point) 'gnus-data)))
5143 (when data 5152 (when data
5144 (mm-save-part data)))) 5153 (mm-save-part data))))
5145 5154
5146(defun gnus-mime-pipe-part (&optional cmd event) 5155(defun gnus-mime-pipe-part (&optional cmd)
5147 "Pipe the MIME part under point to a process." 5156 "Pipe the MIME part under point to a process.
5148 (interactive (list nil last-nonmenu-event)) 5157Use CMD as the process."
5149 (mouse-set-point event) 5158 (interactive)
5150 (gnus-article-check-buffer) 5159 (gnus-article-check-buffer)
5151 (let ((data (get-text-property (point) 'gnus-data))) 5160 (let ((data (get-text-property (point) 'gnus-data)))
5152 (when data 5161 (when data
5153 (mm-pipe-part data cmd)))) 5162 (mm-pipe-part data cmd))))
5154 5163
5155(defun gnus-mime-view-part (&optional event) 5164(defun gnus-mime-view-part ()
5156 "Interactively choose a viewing method for the MIME part under point." 5165 "Interactively choose a viewing method for the MIME part under point."
5157 (interactive (list last-nonmenu-event)) 5166 (interactive)
5158 (save-excursion 5167 (gnus-article-check-buffer)
5159 (mouse-set-point event) 5168 (let ((data (get-text-property (point) 'gnus-data)))
5160 (gnus-article-check-buffer) 5169 (when data
5161 (let ((data (get-text-property (point) 'gnus-data))) 5170 (setq gnus-article-mime-handles
5162 (when data 5171 (mm-merge-handles
5163 (setq gnus-article-mime-handles 5172 gnus-article-mime-handles (setq data (copy-sequence data))))
5164 (mm-merge-handles 5173 (mm-interactively-view-part data))))
5165 gnus-article-mime-handles (setq data (copy-sequence data))))
5166 (mm-interactively-view-part data)))))
5167 5174
5168(defun gnus-mime-view-part-as-type-internal () 5175(defun gnus-mime-view-part-as-type-internal ()
5169 (gnus-article-check-buffer) 5176 (gnus-article-check-buffer)
@@ -5180,13 +5187,11 @@ Deleting parts may malfunction or destroy the article; continue? "))
5180 '("text/plain" . 0)) 5187 '("text/plain" . 0))
5181 '("application/octet-stream" . 0)))) 5188 '("application/octet-stream" . 0))))
5182 5189
5183(defun gnus-mime-view-part-as-type (&optional mime-type pred event) 5190(defun gnus-mime-view-part-as-type (&optional mime-type pred)
5184 "Choose a MIME media type, and view the part as such. 5191 "Choose a MIME media type, and view the part as such.
5185If non-nil, PRED is a predicate to use during completion to limit the 5192If non-nil, PRED is a predicate to use during completion to limit the
5186available media-types." 5193available media-types."
5187 (interactive (list nil nil last-nonmenu-event)) 5194 (interactive)
5188 (save-excursion
5189 (if event (mouse-set-point event))
5190 (unless mime-type 5195 (unless mime-type
5191 (setq mime-type 5196 (setq mime-type
5192 (let ((default (gnus-mime-view-part-as-type-internal))) 5197 (let ((default (gnus-mime-view-part-as-type-internal)))
@@ -5217,14 +5222,13 @@ available media-types."
5217 (mm-merge-handles gnus-article-mime-handles handle)) 5222 (mm-merge-handles gnus-article-mime-handles handle))
5218 (when (mm-handle-displayed-p handle) 5223 (when (mm-handle-displayed-p handle)
5219 (mm-remove-part handle)) 5224 (mm-remove-part handle))
5220 (gnus-mm-display-part handle))))) 5225 (gnus-mm-display-part handle))))
5221 5226
5222(defun gnus-mime-copy-part (&optional handle arg event) 5227(defun gnus-mime-copy-part (&optional handle arg)
5223 "Put the MIME part under point into a new buffer. 5228 "Put the MIME part under point into a new buffer.
5224If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 5229If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
5225are decompressed." 5230are decompressed."
5226 (interactive (list nil current-prefix-arg last-nonmenu-event)) 5231 (interactive (list nil current-prefix-arg))
5227 (mouse-set-point event)
5228 (gnus-article-check-buffer) 5232 (gnus-article-check-buffer)
5229 (unless handle 5233 (unless handle
5230 (setq handle (get-text-property (point) 'gnus-data))) 5234 (setq handle (get-text-property (point) 'gnus-data)))
@@ -5276,12 +5280,9 @@ are decompressed."
5276 (setq buffer-file-name nil)) 5280 (setq buffer-file-name nil))
5277 (goto-char (point-min))))) 5281 (goto-char (point-min)))))
5278 5282
5279(defun gnus-mime-print-part (&optional handle filename event) 5283(defun gnus-mime-print-part (&optional handle filename)
5280 "Print the MIME part under point." 5284 "Print the MIME part under point."
5281 (interactive 5285 (interactive (list nil (ps-print-preprint current-prefix-arg)))
5282 (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
5283 (save-excursion
5284 (mouse-set-point event)
5285 (gnus-article-check-buffer) 5286 (gnus-article-check-buffer)
5286 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5287 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5287 (contents (and handle (mm-get-part handle))) 5288 (contents (and handle (mm-get-part handle)))
@@ -5302,13 +5303,12 @@ are decompressed."
5302 (with-temp-buffer 5303 (with-temp-buffer
5303 (insert contents) 5304 (insert contents)
5304 (gnus-print-buffer)) 5305 (gnus-print-buffer))
5305 (ps-despool filename)))))) 5306 (ps-despool filename)))))
5306 5307
5307(defun gnus-mime-inline-part (&optional handle arg event) 5308(defun gnus-mime-inline-part (&optional handle arg)
5308 "Insert the MIME part under point into the current buffer. 5309 "Insert the MIME part under point into the current buffer.
5309Compressed files like .gz and .bz2 are decompressed." 5310Compressed files like .gz and .bz2 are decompressed."
5310 (interactive (list nil current-prefix-arg last-nonmenu-event)) 5311 (interactive (list nil current-prefix-arg))
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,12 +5402,10 @@ 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 event) 5405(defun gnus-mime-view-part-as-charset (&optional handle arg)
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 last-nonmenu-event)) 5408 (interactive (list nil current-prefix-arg))
5409 (save-excursion
5410 (mouse-set-point event)
5411 (gnus-article-check-buffer) 5409 (gnus-article-check-buffer)
5412 (let ((handle (or handle (get-text-property (point) 'gnus-data))) 5410 (let ((handle (or handle (get-text-property (point) 'gnus-data)))
5413 (fun (get-text-property (point) 'gnus-callback)) 5411 (fun (get-text-property (point) 'gnus-callback))
@@ -5441,13 +5439,11 @@ specified charset."
5441 (setcar (cddr form) 5439 (setcar (cddr form)
5442 (list 'quote (or (cadr (member preferred parts)) 5440 (list 'quote (or (cadr (member preferred parts))
5443 (car parts))))) 5441 (car parts)))))
5444 (funcall fun handle)))))) 5442 (funcall fun handle)))))
5445 5443
5446(defun gnus-mime-view-part-externally (&optional handle event) 5444(defun gnus-mime-view-part-externally (&optional handle)
5447 "View the MIME part under point with an external viewer." 5445 "View the MIME part under point with an external viewer."
5448 (interactive (list nil last-nonmenu-event)) 5446 (interactive)
5449 (save-excursion
5450 (mouse-set-point event)
5451 (gnus-article-check-buffer) 5447 (gnus-article-check-buffer)
5452 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5448 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5453 (mm-inlined-types nil) 5449 (mm-inlined-types nil)
@@ -5462,14 +5458,12 @@ specified charset."
5462 (gnus-mime-view-part-as-type 5458 (gnus-mime-view-part-as-type
5463 nil (lambda (type) (stringp (mailcap-mime-info type)))) 5459 nil (lambda (type) (stringp (mailcap-mime-info type))))
5464 (when handle 5460 (when handle
5465 (mm-display-part handle nil t)))))) 5461 (mm-display-part handle nil t)))))
5466 5462
5467(defun gnus-mime-view-part-internally (&optional handle event) 5463(defun gnus-mime-view-part-internally (&optional handle)
5468 "View the MIME part under point with an internal viewer. 5464 "View the MIME part under point with an internal viewer.
5469If no internal viewer is available, use an external viewer." 5465If no internal viewer is available, use an external viewer."
5470 (interactive (list nil last-nonmenu-event)) 5466 (interactive)
5471 (save-excursion
5472 (mouse-set-point event)
5473 (gnus-article-check-buffer) 5467 (gnus-article-check-buffer)
5474 (let* ((handle (or handle (get-text-property (point) 'gnus-data))) 5468 (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
5475 (mm-inlined-types '(".*")) 5469 (mm-inlined-types '(".*"))
@@ -5483,7 +5477,7 @@ If no internal viewer is available, use an external viewer."
5483 (gnus-mime-view-part-as-type 5477 (gnus-mime-view-part-as-type
5484 nil (lambda (type) (mm-inlinable-p handle type))) 5478 nil (lambda (type) (mm-inlinable-p handle type)))
5485 (when handle 5479 (when handle
5486 (gnus-bind-mm-vars (mm-display-part handle nil t))))))) 5480 (gnus-bind-mm-vars (mm-display-part handle nil t))))))
5487 5481
5488(defun gnus-mime-action-on-part (&optional action) 5482(defun gnus-mime-action-on-part (&optional action)
5489 "Do something with the MIME attachment at (point)." 5483 "Do something with the MIME attachment at (point)."
@@ -5855,7 +5849,7 @@ all parts."
5855 (widget-convert-button 5849 (widget-convert-button
5856 'link b e 5850 'link b e
5857 :mime-handle handle 5851 :mime-handle handle
5858 :action #'gnus-widget-press-button 5852 :action 'gnus-widget-press-button
5859 :button-keymap gnus-mime-button-map 5853 :button-keymap gnus-mime-button-map
5860 :help-echo 5854 :help-echo
5861 (lambda (widget) 5855 (lambda (widget)
@@ -6154,7 +6148,7 @@ If nil, don't show those extra buttons."
6154 article-type multipart 6148 article-type multipart
6155 rear-nonsticky t)) 6149 rear-nonsticky t))
6156 (widget-convert-button 'link from (point) 6150 (widget-convert-button 'link from (point)
6157 :action #'gnus-widget-press-button) 6151 :action 'gnus-widget-press-button)
6158 ;; Do the handles 6152 ;; Do the handles
6159 (while (setq handle (pop handles)) 6153 (while (setq handle (pop handles))
6160 (add-text-properties 6154 (add-text-properties
@@ -6178,7 +6172,7 @@ If nil, don't show those extra buttons."
6178 gnus-data ,handle 6172 gnus-data ,handle
6179 rear-nonsticky t)) 6173 rear-nonsticky t))
6180 (widget-convert-button 'link from (point) 6174 (widget-convert-button 'link from (point)
6181 :action #'gnus-widget-press-button) 6175 :action 'gnus-widget-press-button)
6182 (insert " ")) 6176 (insert " "))
6183 (insert "\n\n")) 6177 (insert "\n\n"))
6184 (when preferred 6178 (when preferred
@@ -7121,11 +7115,13 @@ If given a prefix, show the hidden text instead."
7121 (when (and do-update-line 7115 (when (and do-update-line
7122 (or (numberp article) 7116 (or (numberp article)
7123 (stringp article))) 7117 (stringp article)))
7124 (with-current-buffer gnus-summary-buffer 7118 (let ((buf (current-buffer)))
7119 (set-buffer gnus-summary-buffer)
7125 (gnus-summary-update-article do-update-line sparse-header) 7120 (gnus-summary-update-article do-update-line sparse-header)
7126 (gnus-summary-goto-subject do-update-line nil t) 7121 (gnus-summary-goto-subject do-update-line nil t)
7127 (set-window-point (gnus-get-buffer-window (current-buffer) t) 7122 (set-window-point (gnus-get-buffer-window (current-buffer) t)
7128 (point))))))) 7123 (point))
7124 (set-buffer buf))))))
7129 7125
7130(defun gnus-block-private-groups (group) 7126(defun gnus-block-private-groups (group)
7131 "Allows images in newsgroups to be shown, blocks images in all 7127 "Allows images in newsgroups to be shown, blocks images in all
@@ -7320,7 +7316,8 @@ groups."
7320 (gnus-article-mode) 7316 (gnus-article-mode)
7321 (set-window-configuration winconf) 7317 (set-window-configuration winconf)
7322 ;; Tippy-toe some to make sure that point remains where it was. 7318 ;; Tippy-toe some to make sure that point remains where it was.
7323 (with-current-buffer curbuf 7319 (save-current-buffer
7320 (set-buffer curbuf)
7324 (set-window-start (get-buffer-window (current-buffer)) window-start) 7321 (set-window-start (get-buffer-window (current-buffer)) window-start)
7325 (goto-char p)))) 7322 (goto-char p))))
7326 (gnus-summary-show-article))) 7323 (gnus-summary-show-article)))
@@ -7872,16 +7869,15 @@ call it with the value of the `gnus-data' text property."
7872 (when fun 7869 (when fun
7873 (funcall fun data)))) 7870 (funcall fun data))))
7874 7871
7875(defun gnus-article-press-button (&optional event) 7872(defun gnus-article-press-button ()
7876 "Check text at point for a callback function. 7873 "Check text at point for a callback function.
7877If the text at point has a `gnus-callback' property, 7874If the text at point has a `gnus-callback' property,
7878call it with the value of the `gnus-data' text property." 7875call it with the value of the `gnus-data' text property."
7879 (interactive (list last-nonmenu-event)) 7876 (interactive)
7880 (save-excursion 7877 (let ((data (get-text-property (point) 'gnus-data))
7881 (mouse-set-point event) 7878 (fun (get-text-property (point) 'gnus-callback)))
7882 (let ((fun (get-text-property (point) 'gnus-callback))) 7879 (when fun
7883 (when fun 7880 (funcall fun data))))
7884 (funcall fun (get-text-property (point) 'gnus-data))))))
7885 7881
7886(defun gnus-article-highlight (&optional force) 7882(defun gnus-article-highlight (&optional force)
7887 "Highlight current article. 7883 "Highlight current article.
@@ -8099,7 +8095,7 @@ url is put as the `gnus-button-url' overlay property on the button."
8099 (list 'mouse-face gnus-article-mouse-face)) 8095 (list 'mouse-face gnus-article-mouse-face))
8100 (list 'gnus-callback fun) 8096 (list 'gnus-callback fun)
8101 (and data (list 'gnus-data data)))) 8097 (and data (list 'gnus-data data))))
8102 (widget-convert-button 'link from to :action #'gnus-widget-press-button 8098 (widget-convert-button 'link from to :action 'gnus-widget-press-button
8103 :help-echo (or text "Follow the link") 8099 :help-echo (or text "Follow the link")
8104 :keymap gnus-url-button-map)) 8100 :keymap gnus-url-button-map))
8105 8101
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 9ae28b1290e..485f815d9b9 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 -*- lexical-binding:t -*- 1;;; gnus-cloud.el --- storing and retrieving data via IMAP
2 2
3;; Copyright (C) 2014-2019 Free Software Foundation, Inc. 3;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
4 4
@@ -52,12 +52,14 @@ 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
55 :type '(repeat (choice (string :tag "File") 56 :type '(repeat (choice (string :tag "File")
56 (plist :tag "Property list")))) 57 (plist :tag "Property list"))))
57 58
58(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip) 59(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
59 "Storage method for cloud data, defaults to EPG if that's available." 60 "Storage method for cloud data, defaults to EPG if that's available."
60 :version "26.1" 61 :version "26.1"
62 :group 'gnus-cloud
61 :type '(radio (const :tag "No encoding" nil) 63 :type '(radio (const :tag "No encoding" nil)
62 (const :tag "Base64" base64) 64 (const :tag "Base64" base64)
63 (const :tag "Base64+gzip" base64-gzip) 65 (const :tag "Base64+gzip" base64-gzip)
@@ -66,6 +68,7 @@ against the basename of files in said directory."
66(defcustom gnus-cloud-interactive t 68(defcustom gnus-cloud-interactive t
67 "Whether Gnus Cloud changes should be confirmed." 69 "Whether Gnus Cloud changes should be confirmed."
68 :version "26.1" 70 :version "26.1"
71 :group 'gnus-cloud
69 :type 'boolean) 72 :type 'boolean)
70 73
71(defvar gnus-cloud-group-name "Emacs-Cloud") 74(defvar gnus-cloud-group-name "Emacs-Cloud")
@@ -78,6 +81,7 @@ against the basename of files in said directory."
78 "The IMAP select method used to store the cloud data. 81 "The IMAP select method used to store the cloud data.
79See also `gnus-server-set-cloud-method-server' for an 82See also `gnus-server-set-cloud-method-server' for an
80easy interactive way to set this from the Server buffer." 83easy interactive way to set this from the Server buffer."
84 :group 'gnus-cloud
81 :type '(radio (const :tag "Not set" nil) 85 :type '(radio (const :tag "Not set" nil)
82 (string :tag "A Gnus server name as a string"))) 86 (string :tag "A Gnus server name as a string")))
83 87
@@ -127,7 +131,8 @@ easy interactive way to set this from the Server buffer."
127 (base64-encode-region (point-min) (point-max))) 131 (base64-encode-region (point-min) (point-max)))
128 132
129 ((eq gnus-cloud-storage-method 'epg) 133 ((eq gnus-cloud-storage-method 'epg)
130 (let ((context (epg-make-context 'OpenPGP))) 134 (let ((context (epg-make-context 'OpenPGP))
135 cipher)
131 (setf (epg-context-armor context) t) 136 (setf (epg-context-armor context) t)
132 (setf (epg-context-textmode context) t) 137 (setf (epg-context-textmode context) t)
133 (let ((data (epg-encrypt-string context 138 (let ((data (epg-encrypt-string context
@@ -348,7 +353,6 @@ Use old data if FORCE-OLDER is not nil."
348 (group &optional previous method)) 353 (group &optional previous method))
349 354
350(defun gnus-cloud-ensure-cloud-group () 355(defun gnus-cloud-ensure-cloud-group ()
351 ;; FIXME: `method' is not used!?
352 (let ((method (if (stringp gnus-cloud-method) 356 (let ((method (if (stringp gnus-cloud-method)
353 (gnus-server-to-method gnus-cloud-method) 357 (gnus-server-to-method gnus-cloud-method)
354 gnus-cloud-method))) 358 gnus-cloud-method)))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 4d10e1170da..e2c728df8f4 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -644,14 +644,7 @@ 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))))
655 (list 'gnus-topic name 648 (list 'gnus-topic name
656 'gnus-topic-level level 649 'gnus-topic-level level
657 'gnus-topic-unread unread 650 'gnus-topic-unread unread
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index fcd5ec621cc..31421cc7555 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,7 +87,6 @@ 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)))
91 (let ((tempvar (make-symbol "GnusStartBufferWindow")) 90 (let ((tempvar (make-symbol "GnusStartBufferWindow"))
92 (w (make-symbol "w")) 91 (w (make-symbol "w"))
93 (buf (make-symbol "buf"))) 92 (buf (make-symbol "buf")))
@@ -104,6 +103,9 @@ This is a compatibility function for different Emacsen."
104 ,@forms) 103 ,@forms)
105 (select-window ,tempvar))))) 104 (select-window ,tempvar)))))
106 105
106(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
107(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
108
107(defsubst gnus-goto-char (point) 109(defsubst gnus-goto-char (point)
108 (and point (goto-char point))) 110 (and point (goto-char point)))
109 111
@@ -300,24 +302,26 @@ Symbols are also allowed; their print names are used instead."
300 302
301(defmacro gnus-local-set-keys (&rest plist) 303(defmacro gnus-local-set-keys (&rest plist)
302 "Set the keys in PLIST in the current keymap." 304 "Set the keys in PLIST in the current keymap."
303 (declare (indent 1))
304 `(gnus-define-keys-1 (current-local-map) ',plist)) 305 `(gnus-define-keys-1 (current-local-map) ',plist))
305 306
306(defmacro gnus-define-keys (keymap &rest plist) 307(defmacro gnus-define-keys (keymap &rest plist)
307 "Define all keys in PLIST in KEYMAP." 308 "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))
314 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) 313 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
315 314
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
316(defmacro gnus-define-keymap (keymap &rest plist) 319(defmacro gnus-define-keymap (keymap &rest plist)
317 "Define all keys in PLIST in KEYMAP." 320 "Define all keys in PLIST in KEYMAP."
318 (declare (indent 1))
319 `(gnus-define-keys-1 ,keymap (quote ,plist))) 321 `(gnus-define-keys-1 ,keymap (quote ,plist)))
320 322
323(put 'gnus-define-keymap 'lisp-indent-function 1)
324
321(defun gnus-define-keys-1 (keymap plist &optional safe) 325(defun gnus-define-keys-1 (keymap plist &optional safe)
322 (when (null keymap) 326 (when (null keymap)
323 (error "Can't set keys in a null keymap")) 327 (error "Can't set keys in a null keymap"))
@@ -440,7 +444,7 @@ displayed in the echo area."
440 `(let (str time) 444 `(let (str time)
441 (cond ((eq gnus-add-timestamp-to-message 'log) 445 (cond ((eq gnus-add-timestamp-to-message 'log)
442 (setq str (let (message-log-max) 446 (setq str (let (message-log-max)
443 (apply #'message ,format-string ,args))) 447 (apply 'message ,format-string ,args)))
444 (when (and message-log-max 448 (when (and message-log-max
445 (> message-log-max 0) 449 (> message-log-max 0)
446 (/= (length str) 0)) 450 (/= (length str) 0))
@@ -458,7 +462,7 @@ displayed in the echo area."
458 (gnus-add-timestamp-to-message 462 (gnus-add-timestamp-to-message
459 (if (or (and (null ,format-string) (null ,args)) 463 (if (or (and (null ,format-string) (null ,args))
460 (progn 464 (progn
461 (setq str (apply #'format ,format-string ,args)) 465 (setq str (apply 'format ,format-string ,args))
462 (zerop (length str)))) 466 (zerop (length str))))
463 (prog1 467 (prog1
464 (and ,format-string str) 468 (and ,format-string str)
@@ -467,7 +471,7 @@ displayed in the echo area."
467 (message "%s" (concat ,timestamp str)) 471 (message "%s" (concat ,timestamp str))
468 str)) 472 str))
469 (t 473 (t
470 (apply #'message ,format-string ,args))))))) 474 (apply 'message ,format-string ,args)))))))
471 475
472(defvar gnus-action-message-log nil) 476(defvar gnus-action-message-log nil)
473 477
@@ -486,10 +490,9 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages
486inside loops." 490inside loops."
487 (if (<= level gnus-verbose) 491 (if (<= level gnus-verbose)
488 (let ((message 492 (let ((message
489 (apply (if gnus-add-timestamp-to-message 493 (if gnus-add-timestamp-to-message
490 #'gnus-message-with-timestamp 494 (apply 'gnus-message-with-timestamp args)
491 #'message) 495 (apply 'message args))))
492 args)))
493 (when (and (consp gnus-action-message-log) 496 (when (and (consp gnus-action-message-log)
494 (<= level 3)) 497 (<= level 3))
495 (push message gnus-action-message-log)) 498 (push message gnus-action-message-log))
@@ -497,7 +500,7 @@ inside loops."
497 ;; We have to do this format thingy here even if the result isn't 500 ;; We have to do this format thingy here even if the result isn't
498 ;; shown - the return value has to be the same as the return value 501 ;; shown - the return value has to be the same as the return value
499 ;; from `message'. 502 ;; from `message'.
500 (apply #'format args))) 503 (apply 'format args)))
501 504
502(defun gnus-final-warning () 505(defun gnus-final-warning ()
503 (when (and (consp gnus-action-message-log) 506 (when (and (consp gnus-action-message-log)
@@ -510,7 +513,7 @@ inside loops."
510 "Beep an error if LEVEL is equal to or less than `gnus-verbose'. 513 "Beep an error if LEVEL is equal to or less than `gnus-verbose'.
511ARGS are passed to `message'." 514ARGS are passed to `message'."
512 (when (<= (floor level) gnus-verbose) 515 (when (<= (floor level) gnus-verbose)
513 (apply #'message args) 516 (apply 'message args)
514 (ding) 517 (ding)
515 (let (duration) 518 (let (duration)
516 (when (and (floatp level) 519 (when (and (floatp level)
@@ -685,20 +688,18 @@ Lisp objects are loadable. Bind `print-quoted' and `print-readably'
685to t, and `print-escape-multibyte', `print-escape-newlines', 688to t, and `print-escape-multibyte', `print-escape-newlines',
686`print-escape-nonascii', `print-length', `print-level' and 689`print-escape-nonascii', `print-length', `print-level' and
687`print-string-length' to nil." 690`print-string-length' to nil."
688 `(progn 691 `(let ((print-quoted t)
689 (defvar print-string-length) (defvar print-readably) 692 (print-readably t)
690 (let ((print-quoted t) 693 ;;print-circle
691 (print-readably t) 694 ;;print-continuous-numbering
692 ;;print-circle 695 print-escape-multibyte
693 ;;print-continuous-numbering 696 print-escape-newlines
694 print-escape-multibyte 697 print-escape-nonascii
695 print-escape-newlines 698 ;;print-gensym
696 print-escape-nonascii 699 print-length
697 ;;print-gensym 700 print-level
698 print-length 701 print-string-length)
699 print-level 702 ,@forms))
700 print-string-length)
701 ,@forms)))
702 703
703(defun gnus-prin1 (form) 704(defun gnus-prin1 (form)
704 "Use `prin1' on FORM in the current buffer. 705 "Use `prin1' on FORM in the current buffer.
@@ -851,10 +852,11 @@ the user are disabled, it is recommended that only the most minimal
851operations are performed by FORMS. If you wish to assign many 852operations are performed by FORMS. If you wish to assign many
852complicated values atomically, compute the results into temporary 853complicated values atomically, compute the results into temporary
853variables and then do only the assignment atomically." 854variables 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
858(defmacro gnus-atomic-progn-assign (protect &rest forms) 860(defmacro gnus-atomic-progn-assign (protect &rest forms)
859 "Evaluate FORMS, but ensure that the variables listed in PROTECT 861 "Evaluate FORMS, but ensure that the variables listed in PROTECT
860are not changed if anything in FORMS signals an error or otherwise 862are not changed if anything in FORMS signals an error or otherwise
@@ -864,7 +866,6 @@ It is safe to use gnus-atomic-progn-assign with long computations.
864Note that if any of the symbols in PROTECT were unbound, they will be 866Note that if any of the symbols in PROTECT were unbound, they will be
865set to nil on a successful assignment. In case of an error or other 867set to nil on a successful assignment. In case of an error or other
866non-local exit, it will still be unbound." 868non-local exit, it will still be unbound."
867 (declare (indent 1)) ;;(debug (sexp body))
868 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol 869 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
869 (concat (symbol-name x) 870 (concat (symbol-name x)
870 "-tmp")) 871 "-tmp"))
@@ -877,8 +878,8 @@ non-local exit, it will still be unbound."
877 ,(cadr x)))) 878 ,(cadr x))))
878 temp-sym-map)) 879 temp-sym-map))
879 (sym-temp-let sym-temp-map) 880 (sym-temp-let sym-temp-map)
880 (temp-sym-assign (apply #'append temp-sym-map)) 881 (temp-sym-assign (apply 'append temp-sym-map))
881 (sym-temp-assign (apply #'append sym-temp-map)) 882 (sym-temp-assign (apply 'append sym-temp-map))
882 (result (make-symbol "result-tmp"))) 883 (result (make-symbol "result-tmp")))
883 `(let (,@temp-sym-let 884 `(let (,@temp-sym-let
884 ,result) 885 ,result)
@@ -889,6 +890,9 @@ non-local exit, it will still be unbound."
889 (setq ,@sym-temp-assign)) 890 (setq ,@sym-temp-assign))
890 ,result))) 891 ,result)))
891 892
893(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
894;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
895
892(defmacro gnus-atomic-setq (&rest pairs) 896(defmacro gnus-atomic-setq (&rest pairs)
893 "Similar to setq, except that the real symbols are only assigned when 897 "Similar to setq, except that the real symbols are only assigned when
894there are no errors. And when the real symbols are assigned, they are 898there are no errors. And when the real symbols are assigned, they are
@@ -1098,16 +1102,16 @@ ARG is passed to the first function."
1098(defun gnus-run-hooks (&rest funcs) 1102(defun gnus-run-hooks (&rest funcs)
1099 "Does the same as `run-hooks', but saves the current buffer." 1103 "Does the same as `run-hooks', but saves the current buffer."
1100 (save-current-buffer 1104 (save-current-buffer
1101 (apply #'run-hooks funcs))) 1105 (apply 'run-hooks funcs)))
1102 1106
1103(defun gnus-run-hook-with-args (hook &rest args) 1107(defun gnus-run-hook-with-args (hook &rest args)
1104 "Does the same as `run-hook-with-args', but saves the current buffer." 1108 "Does the same as `run-hook-with-args', but saves the current buffer."
1105 (save-current-buffer 1109 (save-current-buffer
1106 (apply #'run-hook-with-args hook args))) 1110 (apply 'run-hook-with-args hook args)))
1107 1111
1108(defun gnus-run-mode-hooks (&rest funcs) 1112(defun gnus-run-mode-hooks (&rest funcs)
1109 "Run `run-mode-hooks', saving the current buffer." 1113 "Run `run-mode-hooks', saving the current buffer."
1110 (save-current-buffer (apply #'run-mode-hooks funcs))) 1114 (save-current-buffer (apply 'run-mode-hooks funcs)))
1111 1115
1112;;; Various 1116;;; Various
1113 1117
@@ -1190,7 +1194,6 @@ ARG is passed to the first function."
1190 1194
1191;; Fixme: Why not use `with-output-to-temp-buffer'? 1195;; Fixme: Why not use `with-output-to-temp-buffer'?
1192(defmacro gnus-with-output-to-file (file &rest body) 1196(defmacro gnus-with-output-to-file (file &rest body)
1193 (declare (indent 1) (debug (form body)))
1194 (let ((buffer (make-symbol "output-buffer")) 1197 (let ((buffer (make-symbol "output-buffer"))
1195 (size (make-symbol "output-buffer-size")) 1198 (size (make-symbol "output-buffer-size"))
1196 (leng (make-symbol "output-buffer-length")) 1199 (leng (make-symbol "output-buffer-length"))
@@ -1213,6 +1216,9 @@ ARG is passed to the first function."
1213 (write-region (substring ,buffer 0 ,leng) nil ,file 1216 (write-region (substring ,buffer 0 ,leng) nil ,file
1214 ,append 'no-msg)))))) 1217 ,append 'no-msg))))))
1215 1218
1219(put 'gnus-with-output-to-file 'lisp-indent-function 1)
1220(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
1221
1216(defun gnus-add-text-properties-when 1222(defun gnus-add-text-properties-when
1217 (property value start end properties &optional object) 1223 (property value start end properties &optional object)
1218 "Like `add-text-properties', only applied on where PROPERTY is VALUE." 1224 "Like `add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1300,7 +1306,7 @@ sure of changing the value of `foo'."
1300 (setq gnus-info-buffer (current-buffer)) 1306 (setq gnus-info-buffer (current-buffer))
1301 (gnus-configure-windows 'info))) 1307 (gnus-configure-windows 'info)))
1302 1308
1303(defun gnus-not-ignore (&rest _) 1309(defun gnus-not-ignore (&rest args)
1304 t) 1310 t)
1305 1311
1306(defvar gnus-directory-sep-char-regexp "/" 1312(defvar gnus-directory-sep-char-regexp "/"
@@ -1352,7 +1358,7 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1352 `(,spec elem)) 1358 `(,spec elem))
1353 ((listp spec) 1359 ((listp spec)
1354 (if (memq (car spec) '(or and not)) 1360 (if (memq (car spec) '(or and not))
1355 `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec))) 1361 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
1356 (error "Invalid predicate specifier: %s" spec))))) 1362 (error "Invalid predicate specifier: %s" spec)))))
1357 1363
1358(defun gnus-completing-read (prompt collection &optional require-match 1364(defun gnus-completing-read (prompt collection &optional require-match
@@ -1391,8 +1397,6 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1391 ;; Make sure iswitchb is loaded before we let-bind its variables. 1397 ;; Make sure iswitchb is loaded before we let-bind its variables.
1392 ;; If it is loaded inside the let, variables can become unbound afterwards. 1398 ;; If it is loaded inside the let, variables can become unbound afterwards.
1393 (require 'iswitchb) 1399 (require 'iswitchb)
1394 (declare-function iswitchb-minibuffer-setup "iswitchb" ())
1395 (defvar iswitchb-make-buflist-hook)
1396 (let ((iswitchb-make-buflist-hook 1400 (let ((iswitchb-make-buflist-hook
1397 (lambda () 1401 (lambda ()
1398 (setq iswitchb-temp-buflist 1402 (setq iswitchb-temp-buflist
@@ -1406,14 +1410,16 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
1406 (unwind-protect 1410 (unwind-protect
1407 (progn 1411 (progn
1408 (or iswitchb-mode 1412 (or iswitchb-mode
1409 (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)) 1413 (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
1410 (iswitchb-read-buffer prompt def require-match)) 1414 (iswitchb-read-buffer prompt def require-match))
1411 (or iswitchb-mode 1415 (or iswitchb-mode
1412 (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))))) 1416 (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))
1413 1420
1414(defmacro gnus-parse-without-error (&rest body) 1421(defmacro gnus-parse-without-error (&rest body)
1415 "Allow continuing onto the next line even if an error occurs." 1422 "Allow continuing onto the next line even if an error occurs."
1416 (declare (indent 0) (debug (body)))
1417 `(while (not (eobp)) 1423 `(while (not (eobp))
1418 (condition-case () 1424 (condition-case ()
1419 (progn 1425 (progn
@@ -1504,17 +1510,18 @@ Return nil otherwise."
1504 1510
1505(defvar tool-bar-mode) 1511(defvar tool-bar-mode)
1506 1512
1507(defun gnus-tool-bar-update (&rest _) 1513(defun gnus-tool-bar-update (&rest ignore)
1508 "Update the tool bar." 1514 "Update the tool bar."
1509 (when (bound-and-true-p tool-bar-mode) 1515 (when (and (boundp 'tool-bar-mode)
1516 tool-bar-mode)
1510 (let* ((args nil) 1517 (let* ((args nil)
1511 (func (cond ((fboundp 'tool-bar-update) 1518 (func (cond ((fboundp 'tool-bar-update)
1512 #'tool-bar-update) 1519 'tool-bar-update)
1513 ((fboundp 'force-window-update) 1520 ((fboundp 'force-window-update)
1514 #'force-window-update) 1521 'force-window-update)
1515 ((fboundp 'redraw-frame) 1522 ((fboundp 'redraw-frame)
1516 (setq args (list (selected-frame))) 1523 (setq args (list (selected-frame)))
1517 #'redraw-frame) 1524 'redraw-frame)
1518 (t 'ignore)))) 1525 (t 'ignore))))
1519 (apply func args)))) 1526 (apply func args))))
1520 1527
@@ -1529,7 +1536,7 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1529 (if seqs2_n 1536 (if seqs2_n
1530 (let* ((seqs (cons seq1 seqs2_n)) 1537 (let* ((seqs (cons seq1 seqs2_n))
1531 (cnt 0) 1538 (cnt 0)
1532 (heads (mapcar (lambda (_seq) 1539 (heads (mapcar (lambda (seq)
1533 (make-symbol (concat "head" 1540 (make-symbol (concat "head"
1534 (int-to-string 1541 (int-to-string
1535 (setq cnt (1+ cnt)))))) 1542 (setq cnt (1+ cnt))))))
@@ -1562,7 +1569,8 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1562 system-configuration) 1569 system-configuration)
1563 ((memq 'type lst) 1570 ((memq 'type lst)
1564 (symbol-name system-type)) 1571 (symbol-name system-type))
1565 (t nil)))) 1572 (t nil)))
1573 codename)
1566 (cond 1574 (cond
1567 ((not (memq 'emacs lst)) 1575 ((not (memq 'emacs lst))
1568 nil) 1576 nil)
@@ -1578,7 +1586,9 @@ sequence, this is like `mapcar'. With several, it is like the Common Lisp
1578empty directories from OLD-PATH." 1586empty directories from OLD-PATH."
1579 (when (file-exists-p old-path) 1587 (when (file-exists-p old-path)
1580 (let* ((old-dir (file-name-directory old-path)) 1588 (let* ((old-dir (file-name-directory old-path))
1589 (old-name (file-name-nondirectory old-path))
1581 (new-dir (file-name-directory new-path)) 1590 (new-dir (file-name-directory new-path))
1591 (new-name (file-name-nondirectory new-path))
1582 temp) 1592 temp)
1583 (gnus-make-directory new-dir) 1593 (gnus-make-directory new-dir)
1584 (rename-file old-path new-path t) 1594 (rename-file old-path new-path t)
@@ -1683,7 +1693,7 @@ lists of strings."
1683 (setq props (plist-put props :foreground (face-foreground face))) 1693 (setq props (plist-put props :foreground (face-foreground face)))
1684 (setq props (plist-put props :background (face-background face)))) 1694 (setq props (plist-put props :background (face-background face))))
1685 (ignore-errors 1695 (ignore-errors
1686 (apply #'create-image file type data-p props)))) 1696 (apply 'create-image file type data-p props))))
1687 1697
1688(defun gnus-put-image (glyph &optional string category) 1698(defun gnus-put-image (glyph &optional string category)
1689 (let ((point (point))) 1699 (let ((point (point)))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 760bcc2293d..9e52abc1ca7 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,4 +1,4 @@
1;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*- 1;;; nnimap.el --- IMAP interface for Gnus
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 baef5a789ae..39f701ae2a8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -597,7 +597,7 @@ FILE is the file where FUNCTION was probably defined."
597 ;; of the *packages* in which the function is defined. 597 ;; of the *packages* in which the function is defined.
598 (let* ((name (symbol-name symbol)) 598 (let* ((name (symbol-name symbol))
599 (re (concat "\\_<" (regexp-quote name) "\\_>")) 599 (re (concat "\\_<" (regexp-quote name) "\\_>"))
600 (news (directory-files data-directory t "\\`NEWS")) 600 (news (directory-files data-directory t "\\`NEWS.[1-9]"))
601 (place nil) 601 (place nil)
602 (first nil)) 602 (first nil))
603 (with-temp-buffer 603 (with-temp-buffer
@@ -612,7 +612,7 @@ FILE is the file where FUNCTION was probably defined."
612 ;; Almost all entries are of the form "* ... in Emacs NN.MM." 612 ;; Almost all entries are of the form "* ... in Emacs NN.MM."
613 ;; but there are also a few in the form "* Emacs NN.MM is a bug 613 ;; but there are also a few in the form "* Emacs NN.MM is a bug
614 ;; fix release ...". 614 ;; fix release ...".
615 (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)" 615 (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)"
616 nil t)) 616 nil t))
617 (message "Ref found in non-versioned section in %S" 617 (message "Ref found in non-versioned section in %S"
618 (file-name-nondirectory f)) 618 (file-name-nondirectory f))
@@ -621,7 +621,8 @@ FILE is the file where FUNCTION was probably defined."
621 (setq place (list f pos)) 621 (setq place (list f pos))
622 (setq first version))))))))) 622 (setq first version)))))))))
623 (when first 623 (when first
624 (make-text-button first nil 'type 'help-news 'help-args place)))) 624 (make-text-button first nil 'type 'help-news 'help-args place))
625 first))
625 626
626(add-hook 'help-fns-describe-function-functions 627(add-hook 'help-fns-describe-function-functions
627 #'help-fns--mention-first-release) 628 #'help-fns--mention-first-release)
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 201efb7f2a7..f42b594dc46 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 3f28144ed6a..9f603c0c710 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 0ec2b685d83..57702760fbc 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1225,45 +1225,6 @@ 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
1267(defun completion-all-sorted-completions (&optional start end) 1228(defun completion-all-sorted-completions (&optional start end)
1268 (or completion-all-sorted-completions 1229 (or completion-all-sorted-completions
1269 (let* ((start (or start (minibuffer-prompt-end))) 1230 (let* ((start (or start (minibuffer-prompt-end)))
@@ -1293,7 +1254,23 @@ The sort is performed in a destructive way."
1293 (setq all (delete-dups all)) 1254 (setq all (delete-dups all))
1294 (setq last (last all)) 1255 (setq last (last all))
1295 1256
1296 (setq all (completion-sort all nil sort-fun)) 1257 (cond
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))))))))))))
1297 ;; Cache the result. This is not just for speed, but also so that 1274 ;; Cache the result. This is not just for speed, but also so that
1298 ;; repeated calls to minibuffer-force-complete can cycle through 1275 ;; repeated calls to minibuffer-force-complete can cycle through
1299 ;; all possibilities. 1276 ;; all possibilities.
@@ -1910,7 +1887,9 @@ variables.")
1910 ;; not always. 1887 ;; not always.
1911 (let ((sort-fun (completion-metadata-get 1888 (let ((sort-fun (completion-metadata-get
1912 all-md 'display-sort-function))) 1889 all-md 'display-sort-function)))
1913 (completion-sort completions 'prefer-regular sort-fun))) 1890 (if sort-fun
1891 (funcall sort-fun completions)
1892 (sort completions 'string-lessp))))
1914 (when afun 1893 (when afun
1915 (setq completions 1894 (setq completions
1916 (mapcar (lambda (s) 1895 (mapcar (lambda (s)
@@ -2891,9 +2870,7 @@ Return the new suffix."
2891 'point 2870 'point
2892 (substring afterpoint 0 (cdr bounds))))) 2871 (substring afterpoint 0 (cdr bounds)))))
2893 (all (completion-pcm--all-completions prefix pattern table pred))) 2872 (all (completion-pcm--all-completions prefix pattern table pred)))
2894 (when all 2873 (completion-hilit-commonality all point (car bounds))))
2895 (nconc (completion-pcm--hilit-commonality pattern all)
2896 (car bounds)))))
2897 2874
2898;;; Partial-completion-mode style completion. 2875;;; Partial-completion-mode style completion.
2899 2876
@@ -3056,8 +3033,8 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
3056 (when (string-match-p regex c) (push c poss))) 3033 (when (string-match-p regex c) (push c poss)))
3057 (nreverse poss)))))) 3034 (nreverse poss))))))
3058 3035
3059(defvar completion-score-match-tightness 100 3036(defvar flex-score-match-tightness 100
3060 "Controls how the completion style scores its matches. 3037 "Controls how the `flex' completion style scores its matches.
3061 3038
3062Value is a positive number. Values smaller than one make the 3039Value is a positive number. Values smaller than one make the
3063scoring formula value matches scattered along the string, while 3040scoring formula value matches scattered along the string, while
@@ -3102,7 +3079,7 @@ latter (which has two).")
3102 ;; For the numerator, we use the number of +, i.e. the 3079 ;; For the numerator, we use the number of +, i.e. the
3103 ;; length of the pattern. For the denominator, it 3080 ;; length of the pattern. For the denominator, it
3104 ;; sums (1+ (/ (grouplen - 1) 3081 ;; sums (1+ (/ (grouplen - 1)
3105 ;; completion-score-match-tightness)) across all groups of 3082 ;; flex-score-match-tightness)) across all groups of
3106 ;; -, sums one to that total, and then multiples by 3083 ;; -, sums one to that total, and then multiples by
3107 ;; the length of the string. 3084 ;; the length of the string.
3108 (score-numerator 0) 3085 (score-numerator 0)
@@ -3118,7 +3095,7 @@ latter (which has two).")
3118 score-denominator (+ score-denominator 3095 score-denominator (+ score-denominator
3119 1 3096 1
3120 (/ (- a last-b 1) 3097 (/ (- a last-b 1)
3121 completion-score-match-tightness 3098 flex-score-match-tightness
3122 1.0)))) 3099 1.0))))
3123 (setq 3100 (setq
3124 last-b b)))) 3101 last-b b))))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 7beb61bb643..75fc7d62211 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
1;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding:t -*- 1;;; ldap.el --- client interface to LDAP for Emacs
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,60 +592,59 @@ 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 605 arglist dn name value record result proc)
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)
643 (if (or (null filter) 606 (if (or (null filter)
644 (equal "" filter)) 607 (equal "" filter))
645 (error "No search filter")) 608 (error "No search filter"))
646 (setq filter (cons filter attributes)) 609 (setq filter (cons filter attributes))
647 (with-current-buffer buf 610 (with-current-buffer buf
648 (erase-buffer) 611 (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)))))
649 (if passwd 648 (if passwd
650 ;; Leave process-connection-type at its default value. See 649 ;; Leave process-connection-type at its default value. See
651 ;; discussion in Bug#33050. 650 ;; discussion in Bug#33050.
@@ -673,7 +672,7 @@ an alist of attribute/value pairs."
673 " bind distinguished name (binddn)")) 672 " bind distinguished name (binddn)"))
674 (error "Failed ldapsearch invocation: %s \"%s\"" 673 (error "Failed ldapsearch invocation: %s \"%s\""
675 ldap-ldapsearch-prog 674 ldap-ldapsearch-prog
676 (mapconcat #'identity proc-args "\" \"")))))) 675 (mapconcat 'identity proc-args "\" \""))))))
677 (apply #'call-process ldap-ldapsearch-prog 676 (apply #'call-process ldap-ldapsearch-prog
678 ;; Ignore stderr, which can corrupt results 677 ;; Ignore stderr, which can corrupt results
679 nil (list buf nil) nil 678 nil (list buf nil) nil
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 96a7b12c06e..24084c828e1 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 f4ca6e77b46..ac706b949ba 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -334,92 +334,6 @@ 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
423;;;; 337;;;;
424;;;; Helpers 338;;;; Helpers
425;;;; 339;;;;
@@ -444,14 +358,11 @@ functions work correctly. Lisp callers of any other `comment-*'
444function should first call this function explicitly." 358function should first call this function explicitly."
445 (unless (and (not comment-start) noerror) 359 (unless (and (not comment-start) noerror)
446 (unless comment-start 360 (unless comment-start
447 (let ((comment-list (comment-get-syntax))) 361 (let ((cs (read-string "No comment syntax is defined. Use: ")))
448 (if comment-list 362 (if (zerop (length cs))
449 (comment--set-comment-vars comment-list) 363 (error "No comment syntax defined")
450 (let ((cs (read-string "No comment syntax is defined. Use: "))) 364 (set (make-local-variable 'comment-start) cs)
451 (if (zerop (length cs)) 365 (set (make-local-variable 'comment-start-skip) cs))))
452 (error "No comment syntax defined")
453 (set (make-local-variable 'comment-start) cs)
454 (set (make-local-variable 'comment-start-skip) cs))))))
455 ;; comment-use-syntax 366 ;; comment-use-syntax
456 (when (eq comment-use-syntax 'undecided) 367 (when (eq comment-use-syntax 'undecided)
457 (set (make-local-variable 'comment-use-syntax) 368 (set (make-local-variable 'comment-use-syntax)
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index e2bb8adfef5..798475bbc3d 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -83,11 +83,10 @@ 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 (member (downcase scheme) '("file" "http"))) 86 ((not (string= (downcase scheme) "file"))
87 (rng-uri-error "URI `%s' does not use the `file:' or `http:' scheme" uri))) 87 (rng-uri-error "URI `%s' does not use the `file:' scheme" uri)))
88 (when (and (equal (downcase scheme) "file") 88 (when (not (member authority
89 (not (member authority 89 (cons (system-name) '(nil "" "localhost"))))
90 (cons (system-name) '(nil "" "localhost")))))
91 (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'" 90 (rng-uri-error "URI `%s' does not start with `file:///' or `file://localhost/'"
92 uri)) 91 uri))
93 (when query 92 (when query
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index c0bf29a3988..afa33e064f3 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -439,8 +439,7 @@ 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) 442 (xmltok-g comment-open "-") opt) opt))
443 opt))
444 (cdata-section 443 (cdata-section
445 (xmltok+ "!" 444 (xmltok+ "!"
446 (xmltok-g marked-section-open "\\[") 445 (xmltok-g marked-section-open "\\[")
@@ -541,9 +540,7 @@ and VALUE-END, otherwise a STRING giving the value."
541 "%" (xmltok-g param-entity-ref 540 "%" (xmltok-g param-entity-ref
542 ncname 541 ncname
543 (xmltok-g param-entity-ref-close 542 (xmltok-g param-entity-ref-close
544 ";") 543 ";") opt) opt))
545 opt)
546 opt))
547 (starts-with-nmtoken-not-name 544 (starts-with-nmtoken-not-name
548 (xmltok-g nmtoken 545 (xmltok-g nmtoken
549 (xmltok-p name-continue-not-start-char or ":") 546 (xmltok-p name-continue-not-start-char or ":")
@@ -574,8 +571,7 @@ and VALUE-END, otherwise a STRING giving the value."
574 "!" (xmltok-p (xmltok-g comment-first-dash "-" 571 "!" (xmltok-p (xmltok-g comment-first-dash "-"
575 (xmltok-g comment-open "-") opt) 572 (xmltok-g comment-open "-") opt)
576 or (xmltok-g named-markup-declaration 573 or (xmltok-g named-markup-declaration
577 ncname)) 574 ncname)) opt))
578 opt))
579 (after-lt 575 (after-lt
580 (xmltok+ markup-declaration 576 (xmltok+ markup-declaration
581 or (xmltok-g processing-instruction-question 577 or (xmltok-g processing-instruction-question
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 6f83d5a579d..5aa49b29d6f 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -7430,6 +7430,7 @@ 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)
7433 (org-defkey map [(down)] 'outline-next-visible-heading) 7434 (org-defkey map [(down)] 'outline-next-visible-heading)
7434 (org-defkey map [(up)] 'outline-previous-visible-heading) 7435 (org-defkey map [(up)] 'outline-previous-visible-heading)
7435 (if org-goto-auto-isearch 7436 (if org-goto-auto-isearch
@@ -12998,7 +12999,8 @@ Returns the new TODO keyword, or nil if no state change should occur."
12998 (and (= c ?q) (not (rassoc c fulltable)))) 12999 (and (= c ?q) (not (rassoc c fulltable))))
12999 (setq quit-flag t)) 13000 (setq quit-flag t))
13000 ((= c ?\ ) nil) 13001 ((= c ?\ ) nil)
13001 ((car (rassoc c fulltable))) 13002 ((setq e (rassoc c fulltable) tg (car e))
13003 tg)
13002 (t (setq quit-flag t))))))) 13004 (t (setq quit-flag t)))))))
13003 13005
13004(defun org-entry-is-todo-p () 13006(defun org-entry-is-todo-p ()
@@ -15211,11 +15213,11 @@ Returns the new tags string, or nil to not change the current settings."
15211 (setq current (delete tg current)) 15213 (setq current (delete tg current))
15212 (push tg current))) 15214 (push tg current)))
15213 (when exit-after-next (setq exit-after-next 'now))) 15215 (when exit-after-next (setq exit-after-next 'now)))
15214 ((setq tg (car (rassoc c todo-table))) 15216 ((setq e (rassoc c todo-table) tg (car e))
15215 (with-current-buffer buf 15217 (with-current-buffer buf
15216 (save-excursion (org-todo tg))) 15218 (save-excursion (org-todo tg)))
15217 (when exit-after-next (setq exit-after-next 'now))) 15219 (when exit-after-next (setq exit-after-next 'now)))
15218 ((setq tg (car (rassoc c ntable))) 15220 ((setq e (rassoc c ntable) tg (car e))
15219 (if (member tg current) 15221 (if (member tg current)
15220 (setq current (delete tg current)) 15222 (setq current (delete tg current))
15221 (cl-loop for g in groups do 15223 (cl-loop for g in groups do
@@ -17614,28 +17616,27 @@ D may be an absolute day number, or a calendar-type list (month day year)."
17614 17616
17615(defun org-diary-sexp-entry (sexp entry d) 17617(defun org-diary-sexp-entry (sexp entry d)
17616 "Process a SEXP diary ENTRY for date D." 17618 "Process a SEXP diary ENTRY for date D."
17617 ;; FIXME: Consolidate with diary-sexp-entry!
17618 (require 'diary-lib) 17619 (require 'diary-lib)
17619 ;; `org-anniversary' and alike expect ENTRY and DATE to be bound 17620 ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
17620 ;; dynamically. 17621 ;; dynamically.
17621 (let* ((user-sexp (car (read-from-string sexp))) 17622 (let* ((sexp `(let ((entry ,entry)
17622 (sexp `(let ((entry ,entry) (date ',d)) ,user-sexp)) 17623 (date ',d))
17624 ,(car (read-from-string sexp))))
17623 (result (if calendar-debug-sexp (eval sexp) 17625 (result (if calendar-debug-sexp (eval sexp)
17624 (condition-case err 17626 (condition-case nil
17625 (eval sexp) 17627 (eval sexp)
17626 (error 17628 (error
17627 (beep) 17629 (beep)
17628 (message "Bad sexp at line %d in %s: %S\nError: %S" 17630 (message "Bad sexp at line %d in %s: %s"
17629 (org-current-line) 17631 (org-current-line)
17630 (buffer-file-name) user-sexp err) 17632 (buffer-file-name) sexp)
17631 (sleep-for 2)))))) 17633 (sleep-for 2))))))
17632 (cond ((stringp result) (split-string result "; ")) 17634 (cond ((stringp result) (split-string result "; "))
17633 ((and (consp result) 17635 ((and (consp result)
17634 (not (consp (cdr result))) 17636 (not (consp (cdr result)))
17635 (stringp (cdr result))) 17637 (stringp (cdr result))) (cdr result))
17636 (cdr result)) 17638 ((and (consp result)
17637 ((and (consp result) (stringp (car result))) 17639 (stringp (car result))) result)
17638 result)
17639 (result entry)))) 17640 (result entry))))
17640 17641
17641(defun org-diary-to-ical-string (frombuf) 17642(defun org-diary-to-ical-string (frombuf)
@@ -23286,7 +23287,7 @@ major mode."
23286 (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) 23287 (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
23287 (open-line 1)) 23288 (open-line 1))
23288 (org-indent-line) 23289 (org-indent-line)
23289 (insert comment-start))) 23290 (insert "# ")))
23290 23291
23291(defvar comment-empty-lines) ; From newcomment.el. 23292(defvar comment-empty-lines) ; From newcomment.el.
23292(defun org-comment-or-uncomment-region (beg end &rest _) 23293(defun org-comment-or-uncomment-region (beg end &rest _)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 73fd9709211..401e5aa1da5 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,26 +129,31 @@
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)
133 134
134(defcustom pcomplete-dir-ignore nil 135(defcustom pcomplete-dir-ignore nil
135 "A regexp of names to be disregarded during directory completion." 136 "A regexp of names to be disregarded during directory completion."
136 :type '(choice regexp (const :tag "None" nil))) 137 :type '(choice regexp (const :tag "None" nil))
138 :group 'pcomplete)
137 139
138(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin)) 140(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
139 ;; FIXME: the doc mentions file-name completion, but the code 141 ;; FIXME: the doc mentions file-name completion, but the code
140 ;; seems to apply it to all completions. 142 ;; seems to apply it to all completions.
141 "If non-nil, ignore case when doing filename completion." 143 "If non-nil, ignore case when doing filename completion."
142 :type 'boolean) 144 :type 'boolean
145 :group 'pcomplete)
143 146
144(defcustom pcomplete-autolist nil 147(defcustom pcomplete-autolist nil
145 "If non-nil, automatically list possibilities on partial completion. 148 "If non-nil, automatically list possibilities on partial completion.
146This mirrors the optional behavior of tcsh." 149This mirrors the optional behavior of tcsh."
147 :type 'boolean) 150 :type 'boolean
151 :group 'pcomplete)
148 152
149(defcustom pcomplete-suffix-list (list ?/ ?:) 153(defcustom pcomplete-suffix-list (list ?/ ?:)
150 "A list of characters which constitute a proper suffix." 154 "A list of characters which constitute a proper suffix."
151 :type '(repeat character)) 155 :type '(repeat character)
156 :group 'pcomplete)
152(make-obsolete-variable 'pcomplete-suffix-list nil "24.1") 157(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
153 158
154(defcustom pcomplete-recexact nil 159(defcustom pcomplete-recexact nil
@@ -156,22 +161,25 @@ This mirrors the optional behavior of tcsh."
156This mirrors the optional behavior of tcsh. 161This mirrors the optional behavior of tcsh.
157 162
158A non-nil value is useful if `pcomplete-autolist' is non-nil too." 163A non-nil value is useful if `pcomplete-autolist' is non-nil too."
159 :type 'boolean) 164 :type 'boolean
165 :group 'pcomplete)
160 166
161(define-obsolete-variable-alias 167(define-obsolete-variable-alias
162 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") 168 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
163 169
164(defcustom pcomplete-man-function #'man 170(defcustom pcomplete-man-function 'man
165 "A function to that will be called to display a manual page. 171 "A function to that will be called to display a manual page.
166It will be passed the name of the command to document." 172It will be passed the name of the command to document."
167 :type 'function) 173 :type 'function
174 :group 'pcomplete)
168 175
169(defcustom pcomplete-compare-entry-function #'string-lessp 176(defcustom pcomplete-compare-entry-function 'string-lessp
170 "This function is used to order file entries for completion. 177 "This function is used to order file entries for completion.
171The behavior of most all shells is to sort alphabetically." 178The behavior of most all shells is to sort alphabetically."
172 :type '(radio (function-item string-lessp) 179 :type '(radio (function-item string-lessp)
173 (function-item file-newer-than-file-p) 180 (function-item file-newer-than-file-p)
174 (function :tag "Other"))) 181 (function :tag "Other"))
182 :group 'pcomplete)
175 183
176(defcustom pcomplete-help nil 184(defcustom pcomplete-help nil
177 "A string or function (or nil) used for context-sensitive help. 185 "A string or function (or nil) used for context-sensitive help.
@@ -180,7 +188,8 @@ If non-nil, it must a sexp that will be evaluated, and whose
180result will be shown in the minibuffer. 188result will be shown in the minibuffer.
181If nil, the function `pcomplete-man-function' will be called with the 189If nil, the function `pcomplete-man-function' will be called with the
182current command argument." 190current command argument."
183 :type '(choice string sexp (const :tag "Use man page" nil))) 191 :type '(choice string sexp (const :tag "Use man page" nil))
192 :group 'pcomplete)
184 193
185(defcustom pcomplete-expand-before-complete nil 194(defcustom pcomplete-expand-before-complete nil
186 "If non-nil, expand the current argument before completing it. 195 "If non-nil, expand the current argument before completing it.
@@ -190,10 +199,11 @@ resolved first, and the resultant value that will be completed against
190to be inserted in the buffer. Note that exactly what gets expanded 199to be inserted in the buffer. Note that exactly what gets expanded
191and how is entirely up to the behavior of the 200and how is entirely up to the behavior of the
192`pcomplete-parse-arguments-function'." 201`pcomplete-parse-arguments-function'."
193 :type 'boolean) 202 :type 'boolean
203 :group 'pcomplete)
194 204
195(defcustom pcomplete-parse-arguments-function 205(defcustom pcomplete-parse-arguments-function
196 #'pcomplete-parse-buffer-arguments 206 'pcomplete-parse-buffer-arguments
197 "A function to call to parse the current line's arguments. 207 "A function to call to parse the current line's arguments.
198It should be called with no parameters, and with point at the position 208It should be called with no parameters, and with point at the position
199of the argument that is to be completed. 209of the argument that is to be completed.
@@ -208,7 +218,8 @@ representation of that argument), and BEG-POS gives the beginning
208position of each argument, as it is seen by the user. The establishes 218position of each argument, as it is seen by the user. The establishes
209a relationship between the fully resolved value of the argument, and 219a relationship between the fully resolved value of the argument, and
210the textual representation of the argument." 220the textual representation of the argument."
211 :type 'function) 221 :type 'function
222 :group 'pcomplete)
212 223
213(defcustom pcomplete-cycle-completions t 224(defcustom pcomplete-cycle-completions t
214 "If non-nil, hitting the TAB key cycles through the completion list. 225 "If non-nil, hitting the TAB key cycles through the completion list.
@@ -219,7 +230,8 @@ it acts more like zsh or 4nt, showing the first maximal match first,
219followed by any further matches on each subsequent pressing of the TAB 230followed by any further matches on each subsequent pressing of the TAB
220key. \\[pcomplete-list] is the key to press if the user wants to see 231key. \\[pcomplete-list] is the key to press if the user wants to see
221the list of possible completions." 232the list of possible completions."
222 :type 'boolean) 233 :type 'boolean
234 :group 'pcomplete)
223 235
224(defcustom pcomplete-cycle-cutoff-length 5 236(defcustom pcomplete-cycle-cutoff-length 5
225 "If the number of completions is greater than this, don't cycle. 237 "If the number of completions is greater than this, don't cycle.
@@ -234,7 +246,8 @@ has already entered enough input to disambiguate most of the
234possibilities, and therefore they are probably most interested in 246possibilities, and therefore they are probably most interested in
235cycling through the candidates. Set this value to nil if you want 247cycling through the candidates. Set this value to nil if you want
236cycling to always be enabled." 248cycling to always be enabled."
237 :type '(choice integer (const :tag "Always cycle" nil))) 249 :type '(choice integer (const :tag "Always cycle" nil))
250 :group 'pcomplete)
238 251
239(defcustom pcomplete-restore-window-delay 1 252(defcustom pcomplete-restore-window-delay 1
240 "The number of seconds to wait before restoring completion windows. 253 "The number of seconds to wait before restoring completion windows.
@@ -245,13 +258,15 @@ displayed will be restored), after this many seconds of idle time. If
245set to nil, completion windows will be left on second until the user 258set to nil, completion windows will be left on second until the user
246removes them manually. If set to 0, they will disappear immediately 259removes them manually. If set to 0, they will disappear immediately
247after the user enters a key other than TAB." 260after the user enters a key other than TAB."
248 :type '(choice integer (const :tag "Never restore" nil))) 261 :type '(choice integer (const :tag "Never restore" nil))
262 :group 'pcomplete)
249 263
250(defcustom pcomplete-try-first-hook nil 264(defcustom pcomplete-try-first-hook nil
251 "A list of functions which are called before completing an argument. 265 "A list of functions which are called before completing an argument.
252This can be used, for example, for completing things which might apply 266This can be used, for example, for completing things which might apply
253to all arguments, such as variable names after a $." 267to all arguments, such as variable names after a $."
254 :type 'hook) 268 :type 'hook
269 :group 'pcomplete)
255 270
256(defsubst pcomplete-executables (&optional regexp) 271(defsubst pcomplete-executables (&optional regexp)
257 "Complete amongst a list of directories and executables." 272 "Complete amongst a list of directories and executables."
@@ -295,11 +310,13 @@ generate the completions list. This means that the hook
295 (lambda () 310 (lambda ()
296 (pcomplete-here (pcomplete-executables)))) 311 (pcomplete-here (pcomplete-executables))))
297 "Function called for completing the initial command argument." 312 "Function called for completing the initial command argument."
298 :type 'function) 313 :type 'function
314 :group 'pcomplete)
299 315
300(defcustom pcomplete-command-name-function #'pcomplete-command-name 316(defcustom pcomplete-command-name-function 'pcomplete-command-name
301 "Function called for determining the current command name." 317 "Function called for determining the current command name."
302 :type 'function) 318 :type 'function
319 :group 'pcomplete)
303 320
304(defcustom pcomplete-default-completion-function 321(defcustom pcomplete-default-completion-function
305 (function 322 (function
@@ -307,14 +324,16 @@ generate the completions list. This means that the hook
307 (while (pcomplete-here (pcomplete-entries))))) 324 (while (pcomplete-here (pcomplete-entries)))))
308 "Function called when no completion rule can be found. 325 "Function called when no completion rule can be found.
309This function is used to generate completions for every argument." 326This function is used to generate completions for every argument."
310 :type 'function) 327 :type 'function
328 :group 'pcomplete)
311 329
312(defcustom pcomplete-use-paring t 330(defcustom pcomplete-use-paring t
313 "If t, pare alternatives that have already been used. 331 "If t, pare alternatives that have already been used.
314If nil, you will always see the completion set of possible options, no 332If nil, you will always see the completion set of possible options, no
315matter which of those options have already been used in previous 333matter which of those options have already been used in previous
316command arguments." 334command arguments."
317 :type 'boolean) 335 :type 'boolean
336 :group 'pcomplete)
318 337
319(defcustom pcomplete-termination-string " " 338(defcustom pcomplete-termination-string " "
320 "A string that is inserted after any completion or expansion. 339 "A string that is inserted after any completion or expansion.
@@ -323,7 +342,8 @@ words separated by spaces. However, if your list uses a different
323separator character, or if the completion occurs in a word that is 342separator character, or if the completion occurs in a word that is
324already terminated by a character, this variable should be locally 343already terminated by a character, this variable should be locally
325modified to be an empty string, or the desired separation string." 344modified to be an empty string, or the desired separation string."
326 :type 'string) 345 :type 'string
346 :group 'pcomplete)
327 347
328;;; Internal Variables: 348;;; Internal Variables:
329 349
@@ -439,7 +459,7 @@ Same as `pcomplete' but using the standard completion UI."
439 ;; between pcomplete-stub and the buffer's text is simply due to 459 ;; between pcomplete-stub and the buffer's text is simply due to
440 ;; some chars removed by unquoting. Again, this is not 460 ;; some chars removed by unquoting. Again, this is not
441 ;; indispensable but reduces the reliance on c-t-subvert and 461 ;; indispensable but reduces the reliance on c-t-subvert and
442 ;; improves corner case behaviors. See e.g. bug#34888. 462 ;; improves corner case behaviors.
443 (while (progn (setq buftext (pcomplete-unquote-argument 463 (while (progn (setq buftext (pcomplete-unquote-argument
444 (buffer-substring beg (point)))) 464 (buffer-substring beg (point))))
445 (and (> beg argbeg) 465 (and (> beg argbeg)
@@ -481,10 +501,6 @@ Same as `pcomplete' but using the standard completion UI."
481 (setq table (completion-table-case-fold table))) 501 (setq table (completion-table-case-fold table)))
482 (list beg (point) table 502 (list beg (point) table
483 :predicate pred 503 :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))))
488 :exit-function 504 :exit-function
489 ;; If completion is finished, add a terminating space. 505 ;; If completion is finished, add a terminating space.
490 ;; We used to also do this if STATUS is `sole', but 506 ;; We used to also do this if STATUS is `sole', but
@@ -512,7 +528,6 @@ Same as `pcomplete' but using the standard completion UI."
512 "Support extensible programmable completion. 528 "Support extensible programmable completion.
513To use this function, just bind the TAB key to it, or add it to your 529To use this function, just bind the TAB key to it, or add it to your
514completion functions list (it should occur fairly early in the list)." 530completion 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"))
516 (interactive "p") 531 (interactive "p")
517 (if (and interactively 532 (if (and interactively
518 pcomplete-cycle-completions 533 pcomplete-cycle-completions
@@ -555,7 +570,6 @@ completion functions list (it should occur fairly early in the list)."
555;;;###autoload 570;;;###autoload
556(defun pcomplete-reverse () 571(defun pcomplete-reverse ()
557 "If cycling completion is in use, cycle backwards." 572 "If cycling completion is in use, cycle backwards."
558 (declare (obsolete ?? "27.1"))
559 (interactive) 573 (interactive)
560 (call-interactively 'pcomplete)) 574 (call-interactively 'pcomplete))
561 575
@@ -563,7 +577,6 @@ completion functions list (it should occur fairly early in the list)."
563(defun pcomplete-expand-and-complete () 577(defun pcomplete-expand-and-complete ()
564 "Expand the textual value of the current argument. 578 "Expand the textual value of the current argument.
565This will modify the current buffer." 579This will modify the current buffer."
566 (declare (obsolete "use pcomplete-expand and completion-at-point" "27.1"))
567 (interactive) 580 (interactive)
568 (let ((pcomplete-expand-before-complete t)) 581 (let ((pcomplete-expand-before-complete t))
569 (pcomplete))) 582 (pcomplete)))
@@ -571,8 +584,6 @@ This will modify the current buffer."
571;;;###autoload 584;;;###autoload
572(defun pcomplete-continue () 585(defun pcomplete-continue ()
573 "Complete without reference to any cycling completions." 586 "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"))
576 (interactive) 587 (interactive)
577 (setq pcomplete-current-completions nil 588 (setq pcomplete-current-completions nil
578 pcomplete-last-completion-raw nil) 589 pcomplete-last-completion-raw nil)
@@ -583,41 +594,30 @@ This will modify the current buffer."
583 "Expand the textual value of the current argument. 594 "Expand the textual value of the current argument.
584This will modify the current buffer." 595This will modify the current buffer."
585 (interactive) 596 (interactive)
586 (setq pcomplete-current-completions nil 597 (let ((pcomplete-expand-before-complete t)
587 pcomplete-last-completion-raw nil) 598 (pcomplete-expand-only-p t))
588 (catch 'pcompleted 599 (pcomplete)
589 (let* ((pcomplete-stub) 600 (when (and pcomplete-current-completions
590 pcomplete-seen pcomplete-norm-func 601 (> (length pcomplete-current-completions) 0)) ;??
591 pcomplete-args pcomplete-last pcomplete-index 602 (delete-char (- pcomplete-last-completion-length))
592 (pcomplete-autolist pcomplete-autolist) 603 (while pcomplete-current-completions
593 (pcomplete-suffix-list pcomplete-suffix-list) 604 (unless (pcomplete-insert-entry
594 (pcomplete-expand-only-p t)) 605 "" (car pcomplete-current-completions) t
595 (pcomplete-parse-arguments 'expand-before-complete))) 606 pcomplete-last-completion-raw)
596 ;; FIXME: What is this doing? 607 (insert-and-inherit pcomplete-termination-string))
597 (when (and pcomplete-current-completions 608 (setq pcomplete-current-completions
598 (> (length pcomplete-current-completions) 0)) ;?? 609 (cdr pcomplete-current-completions))))))
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)))))
605 610
606;;;###autoload 611;;;###autoload
607(defun pcomplete-help () 612(defun pcomplete-help ()
608 "Display any help information relative to the current argument." 613 "Display any help information relative to the current argument."
609 (interactive) ;FIXME! 614 (interactive)
610 ;; (declare (obsolete ?? "27.1")) 615 (let ((pcomplete-show-help t))
611 (let* ((data (pcomplete-completions-at-point)) 616 (pcomplete)))
612 (helpfun (plist-get (nthcdr 3 data) :context-help-function)))
613 (if helpfun
614 (funcall helpfun)
615 (message "No context-sensitive help available"))))
616 617
617;;;###autoload 618;;;###autoload
618(defun pcomplete-list () 619(defun pcomplete-list ()
619 "Show the list of possible completions for the current argument." 620 "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,21 +1262,20 @@ 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 (cond 1265 (if (and pcomplete-help
1266 ((functionp pcomplete-help) (funcall pcomplete-help)) 1266 (or (and (stringp pcomplete-help)
1267 ((consp pcomplete-help) 1267 (fboundp 'Info-goto-node))
1268 (message "%s" (eval pcomplete-help t))) 1268 (listp pcomplete-help)))
1269 ((and (stringp pcomplete-help) 1269 (if (listp pcomplete-help)
1270 (fboundp 'Info-goto-node)) 1270 (message "%s" (eval pcomplete-help))
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 (Info-goto-node pcomplete-help)) 1273 (funcall (symbol-function 'Info-goto-node) pcomplete-help))
1274 (t
1275 (if pcomplete-man-function 1274 (if pcomplete-man-function
1276 (let ((cmd (funcall pcomplete-command-name-function))) 1275 (let ((cmd (funcall pcomplete-command-name-function)))
1277 (if (and cmd (> (length cmd) 0)) 1276 (if (and cmd (> (length cmd) 0))
1278 (funcall pcomplete-man-function cmd))) 1277 (funcall pcomplete-man-function cmd)))
1279 (message "No context-sensitive help available"))))) 1278 (message "No context-sensitive help available"))))
1280 1279
1281;; general utilities 1280;; general utilities
1282 1281
@@ -1293,12 +1292,12 @@ If specific documentation can't be given, be generic."
1293 l) 1292 l)
1294(define-obsolete-function-alias 1293(define-obsolete-function-alias
1295 'pcomplete-uniqify-list 1294 'pcomplete-uniqify-list
1296 #'pcomplete-uniquify-list "27.1") 1295 'pcomplete-uniquify-list "27.1")
1297 1296
1298(defun pcomplete-process-result (cmd &rest args) 1297(defun pcomplete-process-result (cmd &rest args)
1299 "Call CMD using `call-process' and return the simplest result." 1298 "Call CMD using `call-process' and return the simplest result."
1300 (with-temp-buffer 1299 (with-temp-buffer
1301 (apply #'call-process cmd nil t nil args) 1300 (apply 'call-process cmd nil t nil args)
1302 (skip-chars-backward "\n") 1301 (skip-chars-backward "\n")
1303 (buffer-substring (point-min) (point)))) 1302 (buffer-substring (point-min) (point))))
1304 1303
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 8d6cce690d1..5c18879712c 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -525,8 +525,6 @@ 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
530(defun c-basic-common-init (mode default-style) 528(defun c-basic-common-init (mode default-style)
531 "Do the necessary initialization for the syntax handling routines 529 "Do the necessary initialization for the syntax handling routines
532and the line breaking/filling code. Intended to be used by other 530and the line breaking/filling code. Intended to be used by other
@@ -671,20 +669,15 @@ that requires a literal mode spec at compile time."
671 669
672 ;; Install the functions that ensure that various internal caches 670 ;; Install the functions that ensure that various internal caches
673 ;; don't become invalid due to buffer changes. 671 ;; don't become invalid due to buffer changes.
674 (if c--use-syntax-propertize 672 (when (featurep 'xemacs)
675 (setq-local syntax-propertize-function 673 (make-local-hook 'before-change-functions)
676 (lambda (start end) 674 (make-local-hook 'after-change-functions))
677 (c-before-change start (point-max)) 675 (add-hook 'before-change-functions 'c-before-change nil t)
678 (c-after-change start end (- end start)))) 676 (setq c-just-done-before-change nil)
679 (when (featurep 'xemacs) 677 ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
680 (make-local-hook 'before-change-functions) 678 ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
681 (make-local-hook 'after-change-functions)) 679 ;; c-after-font-lock-init.
682 (add-hook 'before-change-functions 'c-before-change nil t) 680 (add-hook 'after-change-functions 'c-after-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))
688 (when (boundp 'font-lock-extend-after-change-region-function) 681 (when (boundp 'font-lock-extend-after-change-region-function)
689 (set (make-local-variable 'font-lock-extend-after-change-region-function) 682 (set (make-local-variable 'font-lock-extend-after-change-region-function)
690 'c-extend-after-change-region))) ; Currently (2009-05) used by all 683 'c-extend-after-change-region))) ; Currently (2009-05) used by all
@@ -742,17 +735,15 @@ compatible with old code; callers should always specify it."
742 (widen) 735 (widen)
743 (setq c-new-BEG (point-min)) 736 (setq c-new-BEG (point-min))
744 (setq c-new-END (point-max)) 737 (setq c-new-END (point-max))
745 (unless c--use-syntax-propertize 738 (save-excursion
746 (save-excursion 739 (let (before-change-functions after-change-functions)
747 (let (before-change-functions after-change-functions) 740 (mapc (lambda (fn)
748 (mapc (lambda (fn) 741 (funcall fn (point-min) (point-max)))
749 (funcall fn (point-min) (point-max))) 742 c-get-state-before-change-functions)
750 c-get-state-before-change-functions) 743 (mapc (lambda (fn)
751 (mapc (lambda (fn) 744 (funcall fn (point-min) (point-max)
752 (funcall fn (point-min) (point-max) 745 (- (point-max) (point-min))))
753 (- (point-max) (point-min)))) 746 c-before-font-lock-functions))))
754 c-before-font-lock-functions)
755 ))))
756 747
757 (set (make-local-variable 'outline-regexp) "[^#\n\^M]") 748 (set (make-local-variable 'outline-regexp) "[^#\n\^M]")
758 (set (make-local-variable 'outline-level) 'c-outline-level) 749 (set (make-local-variable 'outline-level) 'c-outline-level)
@@ -2059,12 +2050,6 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
2059 ;; 2050 ;;
2060 ;; Type a space in the first blank line, and the fontification of the next 2051 ;; Type a space in the first blank line, and the fontification of the next
2061 ;; line was fouled up by context fontification. 2052 ;; 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))))
2068 (let (new-beg new-end new-region case-fold-search) 2053 (let (new-beg new-end new-region case-fold-search)
2069 (if (and c-in-after-change-fontification 2054 (if (and c-in-after-change-fontification
2070 (< beg c-new-END) (> end c-new-BEG)) 2055 (< beg c-new-END) (> end c-new-BEG))
@@ -2103,8 +2088,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".")
2103(defun c-after-font-lock-init () 2088(defun c-after-font-lock-init ()
2104 ;; Put on `font-lock-mode-hook'. This function ensures our after-change 2089 ;; Put on `font-lock-mode-hook'. This function ensures our after-change
2105 ;; function will get executed before the font-lock one. 2090 ;; function will get executed before the font-lock one.
2106 (when (and c--use-syntax-propertize 2091 (when (memq #'c-after-change after-change-functions)
2107 (memq #'c-after-change after-change-functions))
2108 (remove-hook 'after-change-functions #'c-after-change t) 2092 (remove-hook 'after-change-functions #'c-after-change t)
2109 (add-hook 'after-change-functions #'c-after-change nil t))) 2093 (add-hook 'after-change-functions #'c-after-change nil t)))
2110 2094
@@ -2158,14 +2142,11 @@ This function is called from `c-common-init', once per mode initialization."
2158 (when (eq font-lock-support-mode 'jit-lock-mode) 2142 (when (eq font-lock-support-mode 'jit-lock-mode)
2159 (save-restriction 2143 (save-restriction
2160 (widen) 2144 (widen)
2161 ;; FIXME: This presumes that c-new-BEG and c-new-END have been set
2162 ;; I guess from the before-change-function.
2163 (c-save-buffer-state () ; Protect the undo-list from put-text-property. 2145 (c-save-buffer-state () ; Protect the undo-list from put-text-property.
2164 (if (< c-new-BEG beg) 2146 (if (< c-new-BEG beg)
2165 (put-text-property c-new-BEG beg 'fontified nil)) 2147 (put-text-property c-new-BEG beg 'fontified nil))
2166 (if (> c-new-END end) 2148 (if (> c-new-END end)
2167 (put-text-property end (min c-new-END (point-max)) 2149 (put-text-property end c-new-END 'fontified nil)))))
2168 'fontified nil)))))
2169 (cons c-new-BEG c-new-END)) 2150 (cons c-new-BEG c-new-END))
2170 2151
2171;; Emacs < 22 and XEmacs 2152;; Emacs < 22 and XEmacs
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d5ef37a4c02..254269ddf1a 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -480,7 +480,8 @@ 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 t 483(defcustom cperl-use-syntax-table-text-property
484 (boundp 'parse-sexp-lookup-properties)
484 "Non-nil means CPerl sets up and uses `syntax-table' text property." 485 "Non-nil means CPerl sets up and uses `syntax-table' text property."
485 :type 'boolean 486 :type 'boolean
486 :group 'cperl-speed) 487 :group 'cperl-speed)
@@ -699,7 +700,55 @@ install choose-color.el, available from
699 700
700`fill-paragraph' on a comment may leave the point behind the 701`fill-paragraph' on a comment may leave the point behind the
701paragraph. It also triggers a bug in some versions of Emacs (CPerl tries 702paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
702to detect it and bulk out).") 703to 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'.")
703 752
704(defvar cperl-praise 'please-ignore-this-line 753(defvar cperl-praise 'please-ignore-this-line
705 "Advantages of CPerl mode. 754 "Advantages of CPerl mode.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 30c9b813407..4306f5daa02 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -152,8 +152,7 @@ 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") 155 "Continue" "Run") gud-go
156 gud-go
157 :visible (and (eq gud-minor-mode 'gdbmi) 156 :visible (and (eq gud-minor-mode 'gdbmi)
158 (gdb-show-run-p))) 157 (gdb-show-run-p)))
159 ([stop] menu-item "Stop" gud-stop-subjob 158 ([stop] menu-item "Stop" gud-stop-subjob
@@ -191,8 +190,7 @@ Used to gray out relevant toolbar icons.")
191 (eq gud-minor-mode 'gdbmi))) 190 (eq gud-minor-mode 'gdbmi)))
192 ([print*] menu-item (if (eq gud-minor-mode 'jdb) 191 ([print*] menu-item (if (eq gud-minor-mode 'jdb)
193 "Dump object" 192 "Dump object"
194 "Print Dereference") 193 "Print Dereference") gud-pstar
195 gud-pstar
196 :enable (not gud-running) 194 :enable (not gud-running)
197 :visible (memq gud-minor-mode '(gdbmi gdb jdb))) 195 :visible (memq gud-minor-mode '(gdbmi gdb jdb)))
198 ([print] menu-item "Print Expression" gud-print 196 ([print] menu-item "Print Expression" gud-print
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index 33c69e168f4..aa412304c59 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -33,11 +33,12 @@
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")))
40 (modify-syntax-entry ?\\ "\\" table) 36 (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)
41 (modify-syntax-entry ?+ "." table) 42 (modify-syntax-entry ?+ "." table)
42 (modify-syntax-entry ?- "." table) 43 (modify-syntax-entry ?- "." table)
43 (modify-syntax-entry ?= "." table) 44 (modify-syntax-entry ?= "." table)
@@ -203,11 +204,10 @@
203 (let ((tok (smie-default-backward-token))) 204 (let ((tok (smie-default-backward-token)))
204 (cond 205 (cond
205 ((zerop (length tok)) 206 ((zerop (length tok))
206 (if (bobp) (setq res ":") 207 (let ((forward-sexp-function nil))
207 (let ((forward-sexp-function nil)) 208 (condition-case nil
208 (condition-case nil 209 (forward-sexp -1)
209 (forward-sexp -1) 210 (scan-error (setq res ":")))))
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,6 +311,9 @@ 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) "\\(?:(\\*+\\|//+\\) *")
314 (set (make-local-variable 'parse-sexp-ignore-comments) t) 317 (set (make-local-variable 'parse-sexp-ignore-comments) t)
315 (set (make-local-variable 'font-lock-defaults) 318 (set (make-local-variable 'font-lock-defaults)
316 '((m3-font-lock-keywords 319 '((m3-font-lock-keywords
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 28d8746ffaf..e1f9a33a691 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -628,8 +628,7 @@ builtins.")
628 ;; OS specific 628 ;; OS specific
629 "VMSError" "WindowsError" 629 "VMSError" "WindowsError"
630 ) 630 )
631 symbol-end) 631 symbol-end) . font-lock-type-face)
632 . font-lock-type-face)
633 ;; assignments 632 ;; assignments
634 ;; support for a = b = c = 5 633 ;; support for a = b = c = 5
635 (,(lambda (limit) 634 (,(lambda (limit)
@@ -679,7 +678,6 @@ Which one will be chosen depends on the value of
679 ((rx (or "\"\"\"" "'''")) 678 ((rx (or "\"\"\"" "'''"))
680 (0 (ignore (python-syntax-stringify)))))) 679 (0 (ignore (python-syntax-stringify))))))
681 680
682;; Always define the alias(es) *before* the variable.
683(define-obsolete-variable-alias 'python--prettify-symbols-alist 681(define-obsolete-variable-alias 'python--prettify-symbols-alist
684 'python-prettify-symbols-alist "26.1") 682 'python-prettify-symbols-alist "26.1")
685 683
diff --git a/lisp/startup.el b/lisp/startup.el
index 2b4f4c7520c..7759ed5aed3 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -980,13 +980,6 @@ 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
990(defun command-line () 983(defun command-line ()
991 "A subroutine of `normal-top-level'. 984 "A subroutine of `normal-top-level'.
992Amongst another things, it parses the command-line arguments." 985Amongst another things, it parses the command-line arguments."
@@ -1384,16 +1377,6 @@ please check its value")
1384 (eq face-ignored-fonts old-face-ignored-fonts)) 1377 (eq face-ignored-fonts old-face-ignored-fonts))
1385 (clear-face-cache))) 1378 (clear-face-cache)))
1386 1379
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
1397 (setq after-init-time (current-time)) 1380 (setq after-init-time (current-time))
1398 ;; Display any accumulated warnings after all functions in 1381 ;; Display any accumulated warnings after all functions in
1399 ;; `after-init-hook' like `desktop-read' have finalized possible 1382 ;; `after-init-hook' like `desktop-read' have finalized possible
diff --git a/lisp/subr.el b/lisp/subr.el
index 3f5e1d7a3a4..baff1e909a1 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 (delete elt (if (nlistp seq) 828 (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 seq 831 (delete elt seq)
832 (copy-sequence seq)))) 832 (delete elt (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))
855 ;; Don't use a defalias, since the `pure' property is only true for 854 ;; Don't use a defalias, since the `pure' property is only true for
856 ;; the calling convention of `kbd'. 855 ;; the calling convention of `kbd'.
857 (read-kbd-macro keys)) 856 (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,17 +5586,6 @@ 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
5600(defconst regexp-unmatchable "\\`a\\`" 5589(defconst regexp-unmatchable "\\`a\\`"
5601 "Standard regexp guaranteed not to match any string at all.") 5590 "Standard regexp guaranteed not to match any string at all.")
5602 5591
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index d612217bdb9..c4b0a8fb6e6 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1107,7 +1107,6 @@ 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!
1111 (clear-face-cache))) 1110 (clear-face-cache)))
1112 1111
1113(defun xterm-maybe-set-dark-background-mode (redc greenc bluec) 1112(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 19e0039ea53..5d5d787945d 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 7d951ff16e8..c285491a305 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -900,12 +900,6 @@ 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
909(declare-function comment-search-forward "newcomment" (limit &optional noerror)) 903(declare-function comment-search-forward "newcomment" (limit &optional noerror))
910(declare-function comment-string-strip "newcomment" (str beforep afterp)) 904(declare-function comment-string-strip "newcomment" (str beforep afterp))
911 905
diff --git a/lisp/window.el b/lisp/window.el
index 00523d57cd8..726d022dfe9 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 a330604e9bd..5ff718292d3 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 a down-event 87 ;; This is an "up-only" event. Pretend there was an up-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 86ecf5291c6..64aaa8acdfa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5989,28 +5989,6 @@ 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
6014DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", 5992DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
6015 doc: /* Reclaim storage for Lisp objects no longer needed. 5993 doc: /* Reclaim storage for Lisp objects no longer needed.
6016Garbage collection happens automatically if you cons more than 5994Garbage collection happens automatically if you cons more than
@@ -7411,7 +7389,6 @@ N should be nonnegative. */);
7411 defsubr (&Smake_finalizer); 7389 defsubr (&Smake_finalizer);
7412 defsubr (&Spurecopy); 7390 defsubr (&Spurecopy);
7413 defsubr (&Sgarbage_collect); 7391 defsubr (&Sgarbage_collect);
7414 defsubr (&Sgarbage_collect_maybe);
7415 defsubr (&Smemory_info); 7392 defsubr (&Smemory_info);
7416 defsubr (&Smemory_use_counts); 7393 defsubr (&Smemory_use_counts);
7417 defsubr (&Ssuspicious_object); 7394 defsubr (&Ssuspicious_object);
diff --git a/src/keyboard.c b/src/keyboard.c
index 9e1567f8cfe..56916e0cb4e 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 (); /* FIXME: Why? */ 2731 maybe_gc ();
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 0b67fb3f1f1..4f1e5729be1 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -876,6 +876,15 @@ 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
879(ert-deftest electric-modes-int-main-allman-style () 888(ert-deftest electric-modes-int-main-allman-style ()
880 (ert-with-test-buffer () 889 (ert-with-test-buffer ()
881 (plainer-c-mode) 890 (plainer-c-mode)
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 428b19226b4..35df7cc17f1 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 () ;bug#34888 77(ert-deftest completion-table-subvert-test ()
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 c8fe00dd393..525f62a3c0b 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 (defvar tramp-display-escape-sequence-regexp) ;Defined in tramp-sh.el 3888
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))