[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 698ff55 1/2: * lisp/calc/calc-ext.el (math-scalarp)
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 698ff55 1/2: * lisp/calc/calc-ext.el (math-scalarp): Fix typo |
|
Date: |
Wed, 26 Jun 2019 10:05:03 -0400 (EDT) |
branch: master
commit 698ff554ac2699ec48fefc85a1307cbc4a183b0d
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* lisp/calc/calc-ext.el (math-scalarp): Fix typo
---
.dir-locals.el | 2 +-
.gitignore | 1 -
lisp/Makefile.in | 7 +-
lisp/abbrev.el | 3 +-
lisp/calc/calc-math.el | 17 ++-
lisp/calendar/time-date.el | 4 +-
lisp/completion.el | 2 +-
lisp/composite.el | 5 +-
lisp/elec-pair.el | 3 +-
lisp/electric.el | 38 +++---
lisp/emacs-lisp/bytecomp.el | 20 ++-
lisp/emacs-lisp/generic.el | 66 +---------
lisp/emacs-lisp/lisp-mode.el | 1 +
lisp/emacs-lisp/package.el | 20 ---
lisp/emacs-lisp/pcase.el | 29 ++++-
lisp/emacs-lisp/regexp-opt.el | 2 +-
lisp/emacs-lisp/smie.el | 8 +-
lisp/emulation/viper-cmd.el | 120 +++++++++---------
lisp/emulation/viper-ex.el | 2 +-
lisp/emulation/viper-util.el | 2 +
lisp/erc/erc-track.el | 29 ++---
lisp/erc/erc.el | 2 +-
lisp/eshell/esh-util.el | 9 +-
lisp/follow.el | 142 +++++++++++----------
lisp/format-spec.el | 2 +-
lisp/frame.el | 37 ++++--
lisp/gnus/gnus-art.el | 284 +++++++++++++++++++++---------------------
lisp/gnus/gnus-cloud.el | 10 +-
lisp/gnus/gnus-topic.el | 9 +-
lisp/gnus/gnus-util.el | 114 ++++++++---------
lisp/gnus/nnimap.el | 2 +-
lisp/help-fns.el | 7 +-
lisp/international/quail.el | 2 +-
lisp/mh-e/mh-funcs.el | 4 +-
lisp/minibuffer.el | 73 +++++++----
lisp/net/ldap.el | 109 ++++++++--------
lisp/net/rcirc.el | 4 +-
lisp/newcomment.el | 99 ++++++++++++++-
lisp/nxml/rng-uri.el | 9 +-
lisp/nxml/xmltok.el | 10 +-
lisp/org/org.el | 29 +++--
lisp/pcomplete.el | 161 ++++++++++++------------
lisp/progmodes/cc-mode.el | 59 ++++++---
lisp/progmodes/cperl-mode.el | 53 +-------
lisp/progmodes/gud.el | 6 +-
lisp/progmodes/modula2.el | 21 ++--
lisp/progmodes/python.el | 4 +-
lisp/startup.el | 17 +++
lisp/subr.el | 23 +++-
lisp/term/xterm.el | 1 +
lisp/textmodes/css-mode.el | 2 +-
lisp/textmodes/fill.el | 6 +
lisp/window.el | 2 +-
lisp/xt-mouse.el | 2 +-
src/alloc.c | 23 ++++
src/keyboard.c | 2 +-
test/lisp/electric-tests.el | 9 --
test/lisp/minibuffer-tests.el | 2 +-
test/lisp/net/tramp-tests.el | 2 +-
59 files changed, 915 insertions(+), 818 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index ffd65c8..5db7479 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,6 @@
((nil . ((tab-width . 8)
(sentence-end-double-space . t)
- (fill-column . 70)
+ (fill-column . 79)
(bug-reference-url-format . "https://debbugs.gnu.org/%s";)))
(c-mode . ((c-file-style . "GNU")
(c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
diff --git a/.gitignore b/.gitignore
index e75df8b..389fb45 100644
--- a/.gitignore
+++ b/.gitignore
@@ -251,7 +251,6 @@ gnustmp*
# Version control and locks.
*.orig
-*.rej
*.swp
*~
.#*
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index ee2c209..68c8c12 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -63,7 +63,8 @@ EMACS = ../src/emacs${EXEEXT}
EMACSOPT = -batch --no-site-file --no-site-lisp
# Extra flags to pass to the byte compiler
-BYTE_COMPILE_EXTRA_FLAGS =
+BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-force-lexical-warnings
t)'
+
# For example to not display the undefined function warnings you can use this:
# BYTE_COMPILE_EXTRA_FLAGS = --eval '(setq byte-compile-warnings (quote (not
unresolved)))'
# The example above is just for developers, it should not be used by default.
@@ -85,7 +86,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el
${srcdir}/finder-inf.el \
# Set load-prefer-newer for the benefit of the non-bootstrappers.
BYTE_COMPILE_FLAGS = \
- --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS)
+ --eval '(setq load-prefer-newer t byte-compile-force-lexical-warnings t)'
$(BYTE_COMPILE_EXTRA_FLAGS)
# Files to compile before others during a bootstrap. This is done to
# speed up the bootstrap process. They're ordered by size, so we use
@@ -316,7 +317,7 @@ compile-targets: $(TARGETS)
# Compile all the Elisp files that need it. Beware: it approximates
# 'no-byte-compile', so watch out for false-positives!
compile-main: gen-lisp compile-clean
- @(cd $(lisp) && \
+ @(cd $(lisp) && \
els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e
's| |/*.el |g'`; \
for el in ${MAIN_FIRST} $$els; do \
test -f $$el || continue; \
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 3d0a843..f8c8223 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -648,7 +648,8 @@ either a single abbrev table or a list of abbrev tables."
;; to treat the distinction between a single table and a list of tables.
(cond
((consp tables) tables)
- ((vectorp tables) (list tables))
+ ((abbrev-table-p tables) (list tables))
+ (tables (signal 'wrong-type-argument (list 'abbrev-table-p tables)))
(t
(let ((tables (if (listp local-abbrev-table)
(append local-abbrev-table
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 4ca8515..f9a4200 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -31,9 +31,8 @@
(require 'calc-macs)
-;;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
-;;; then back off by one.
-
+;; Find out how many 9s in 9.9999... will give distinct Emacs floats,
+;; then back off by one.
(defvar math-emacs-precision
(let* ((n 1)
(x 9)
@@ -46,9 +45,9 @@
(1- n))
"The number of digits in an Emacs float.")
-;;; Find the largest power of 10 which is an Emacs float,
-;;; then back off by one so that any float d.dddd...eN
-;;; is an Emacs float, for acceptable d.dddd....
+;; Find the largest power of 10 which is an Emacs float,
+;; then back off by one so that any float d.dddd...eN
+;; is an Emacs float, for acceptable d.dddd....
(defvar math-largest-emacs-expt
(let ((x 1)
@@ -367,9 +366,9 @@ If this can't be done, return NIL."
(message "Angles measured in radians")))
-;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
-;;; This method takes advantage of the fact that Newton's method starting
-;;; with an overestimate always works, even using truncating integer division!
+;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
+;; This method takes advantage of the fact that Newton's method starting
+;; with an overestimate always works, even using truncating integer division!
(defun math-isqrt (a)
(cond ((Math-zerop a) a)
((not (natnump a))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 2c0280c..dad87dc 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."
(let ((overflow-error '(error "Specified time is not representable")))
(if (equal err overflow-error)
(signal (car err) (cdr err))
- (condition-case err
+ (condition-case-unless-debug err
(encode-time (parse-time-string
- (timezone-make-date-arpa-standard date)))
+ (timezone-make-date-arpa-standard date)))
(error
(if (equal err overflow-error)
(signal (car err) (cdr err))
diff --git a/lisp/completion.el b/lisp/completion.el
index b9c3a21..d545099 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."
(defun completion-before-command ()
(funcall (or (and (symbolp this-command)
(get this-command 'completion-function))
- 'use-completion-under-or-before-point)))
+ #'use-completion-under-or-before-point)))
;; Lisp mode diffs.
diff --git a/lisp/composite.el b/lisp/composite.el
index e0d0721..926fa44 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,4 +1,4 @@
-;;; composite.el --- support character composition
+;;; composite.el --- support character composition -*- lexical-binding:t -*-
;; Copyright (C) 2001-2019 Free Software Foundation, Inc.
@@ -588,7 +588,6 @@ All non-spacing characters have this function in
(as (lglyph-ascent glyph))
(de (lglyph-descent glyph))
(ce (/ (+ lb rb) 2))
- (w (lglyph-width glyph))
xoff yoff)
(cond
((and class (>= class 200) (<= class 240))
@@ -689,9 +688,7 @@ All non-spacing characters have this function in
(defun compose-gstring-for-dotted-circle (gstring direction)
(let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
- (dc-id (lglyph-code dc))
(fc (lgstring-glyph gstring 1)) ; glyph of the following char
- (fc-id (lglyph-code fc))
(gstr (and nil (font-shape-gstring gstring direction))))
(if (and gstr
(or (= (lgstring-glyph-len gstr) 1)
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 5fb9d75..6728525 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -551,7 +551,8 @@ happened."
(goto-char pos)
(funcall electric-pair-inhibit-predicate
last-command-event)))))
- (save-excursion (electric-pair--insert pair)))))
+ (let ((electric-indent--destination (point-marker)))
+ (save-excursion (electric-pair--insert pair))))))
(_
(when (and (if (functionp electric-pair-open-newline-between-pairs)
(funcall electric-pair-open-newline-between-pairs)
diff --git a/lisp/electric.el b/lisp/electric.el
index 53e53bd..c70e60b 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -220,6 +220,14 @@ If `indent-line-function' is one of those, then
`electric-indent-mode' will
not try to reindent lines. It is normally better to make the major
mode set `electric-indent-inhibit', but this can be used as a workaround.")
+(defun electric-indent--inhibited-p ()
+ (or electric-indent-inhibit
+ (memq indent-line-function
+ electric-indent-functions-without-reindent)))
+
+(defvar electric-indent--destination nil
+ "If non-nil, position to which point will be later restored.")
+
(defun electric-indent-post-self-insert-function ()
"Function that `electric-indent-mode' adds to `post-self-insert-hook'.
This indents if the hook `electric-indent-functions' returns non-nil,
@@ -261,26 +269,26 @@ or comment."
(when at-newline
(let ((before (copy-marker (1- pos) t)))
(save-excursion
- (unless
- (or (memq indent-line-function
- electric-indent-functions-without-reindent)
- electric-indent-inhibit)
+ (unless (electric-indent--inhibited-p)
;; Don't reindent the previous line if the
;; indentation function is not a real one.
(goto-char before)
(condition-case-unless-debug ()
(indent-according-to-mode)
- (error (throw 'indent-error nil)))
- ;; The goal here will be to remove the trailing
- ;; whitespace after reindentation of the previous line
- ;; because that may have (re)introduced it.
- (goto-char before)
- ;; We were at EOL in marker `before' before the call
- ;; to `indent-according-to-mode' but after we may
- ;; not be (Bug#15767).
- (when (and (eolp))
- (delete-horizontal-space t))))))
- (unless (and electric-indent-inhibit
+ (error (throw 'indent-error nil))))
+ ;; The goal here will be to remove the trailing
+ ;; whitespace after reindentation of the previous line
+ ;; because that may have (re)introduced it.
+ (goto-char before)
+ ;; We were at EOL in marker `before' before the call
+ ;; to `indent-according-to-mode' but after we may
+ ;; not be (Bug#15767).
+ (when (and (eolp)
+ ;; Don't delete "trailing space" before point!
+ (not (and electric-indent--destination
+ (= (point)
electric-indent--destination))))
+ (delete-horizontal-space t)))))
+ (unless (and (electric-indent--inhibited-p)
(not at-newline))
(condition-case-unless-debug ()
(indent-according-to-mode)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4315254..d8ea33a 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."
lexenv reserved-csts)
;; OUTPUT-TYPE advises about how form is expected to be used:
;; 'eval or nil -> a single form,
- ;; 'progn or t -> a list of forms,
+ ;; t -> a list of forms,
;; 'lambda -> body of a lambda,
;; 'file -> used at file-level.
(let ((byte-compile--for-effect for-effect)
@@ -3044,21 +3044,19 @@ for symbols generated by the byte compiler itself."
;; a single atom, but that causes confusion if the docstring
;; uses the (file . pos) syntax. Besides, now that we have
;; the Lisp_Compiled type, the compiled form is faster.
- ;; eval -> atom, quote or (function atom atom atom)
- ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
+ ;; eval/nil-> atom, quote or (function atom atom atom)
+ ;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
;; file -> as progn, but takes both quotes and atoms, and longer forms.
- (let (rest
- (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
- tmp body)
+ (let (body tmp)
(cond
;; #### This should be split out into byte-compile-nontrivial-function-p.
((or (eq output-type 'lambda)
(nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
(assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
(not (setq tmp (assq 'byte-return byte-compile-output)))
- (progn
- (setq rest (nreverse
- (cdr (memq tmp (reverse byte-compile-output)))))
+ (let ((maycall t) ; t if we may make a funcall.
+ (rest (nreverse
+ (cdr (memq tmp (reverse byte-compile-output))))))
(while
(cond
((memq (car (car rest)) '(byte-varref byte-constant))
@@ -3067,7 +3065,7 @@ for symbols generated by the byte compiler itself."
(or (consp tmp)
(and (symbolp tmp)
(not (macroexp--const-symbol-p tmp)))))
- (if maycall
+ (if maycall ;;Why? --Stef
(setq body (cons (list 'quote tmp) body)))
(setq body (cons tmp body))))
((and maycall
@@ -3075,7 +3073,7 @@ for symbols generated by the byte compiler itself."
(null (nthcdr 3 rest))
(setq tmp (get (car (car rest)) 'byte-opcode-invert))
(or (null (cdr rest))
- (and (memq output-type '(file progn t))
+ (and (memq output-type '(file t))
(cdr (cdr rest))
(eq (car (nth 1 rest)) 'byte-discard)
(progn (setq rest (cdr rest)) t))))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index e4ed745..3b6ea12 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -234,73 +234,13 @@ Some generic modes are defined in `generic-x.el'."
(cond
((characterp end) (setq end (char-to-string end)))
((zerop (length end)) (setq end "\n")))
- (push (cons start end) normalized)))
+ (push (list start end) normalized)))
(nreverse normalized)))
-(defun generic-set-comment-syntax (st comment-list)
- "Set up comment functionality for generic mode."
- (let ((chars nil)
- (comstyles)
- (comstyle "")
- (comment-start nil))
-
- ;; Go through all the comments.
- (pcase-dolist (`(,start . ,end) comment-list)
- (let ((comstyle
- ;; Reuse comstyles if necessary.
- (or (cdr (assoc start comstyles))
- (cdr (assoc end comstyles))
- ;; Otherwise, use a style not yet in use.
- (if (not (rassoc "" comstyles)) "")
- (if (not (rassoc "b" comstyles)) "b")
- "c")))
- (push (cons start comstyle) comstyles)
- (push (cons end comstyle) comstyles)
-
- ;; Setup the syntax table.
- (if (= (length start) 1)
- (modify-syntax-entry (aref start 0)
- (concat "< " comstyle) st)
- (let ((c0 (aref start 0)) (c1 (aref start 1)))
- ;; Store the relevant info but don't update yet.
- (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
- (push (cons c1 (concat (cdr (assoc c1 chars))
- (concat "2" comstyle))) chars)))
- (if (= (length end) 1)
- (modify-syntax-entry (aref end 0)
- (concat ">" comstyle) st)
- (let ((c0 (aref end 0)) (c1 (aref end 1)))
- ;; Store the relevant info but don't update yet.
- (push (cons c0 (concat (cdr (assoc c0 chars))
- (concat "3" comstyle))) chars)
- (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
-
- ;; Process the chars that were part of a 2-char comment marker
- (with-syntax-table st ;For `char-syntax'.
- (dolist (cs (nreverse chars))
- (modify-syntax-entry (car cs)
- (concat (char-to-string (char-syntax (car cs)))
- " " (cdr cs))
- st)))))
-
-(defun generic-set-comment-vars (comment-list)
- (when comment-list
- (setq-local comment-start (caar comment-list))
- (setq-local comment-end
- (let ((end (cdar comment-list)))
- (if (string-equal end "\n") "" end)))
- (setq-local comment-start-skip
- (concat (regexp-opt (mapcar #'car comment-list))
- "+[ \t]*"))
- (setq-local comment-end-skip
- (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list))))))
-
(defun generic-mode-set-comments (comment-list)
"Set up comment functionality for generic mode."
- (let ((st (make-syntax-table))
- (comment-list (generic--normalize-comments comment-list)))
- (generic-set-comment-syntax st comment-list)
- (generic-set-comment-vars comment-list)
+ (let ((st (make-syntax-table)))
+ (comment-set-syntax st comment-list)
(set-syntax-table st)))
(defun generic-bracket-support ()
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index fa6dc98..ac47d98 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -237,6 +237,7 @@
(eval-when-compile
(concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>"))
limit t)
+ ;; FIXME: If it's indented like `defun' then highlight the first arg!
(let ((sym (intern-soft (match-string 1))))
(when (or (special-form-p sym)
(and (macrop sym)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index b60a8a1..5b136bd 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1163,26 +1163,6 @@ The return result is a `package-desc'."
(insert (format "Error while verifying signature %s:\n" sig-file)))
(insert "\nCommand output:\n" (epg-context-error-output context))))))
-(defmacro package--with-work-buffer (location file &rest body)
- "Run BODY in a buffer containing the contents of FILE at LOCATION.
-LOCATION is the base location of a package archive, and should be
-one of the URLs (or file names) specified in `package-archives'.
-FILE is the name of a file relative to that base location.
-
-This macro retrieves FILE from LOCATION into a temporary buffer,
-and evaluates BODY while that buffer is current. This work
-buffer is killed afterwards. Return the last value in BODY."
- (declare (indent 2) (debug t)
- (obsolete package--with-response-buffer "25.1"))
- `(with-temp-buffer
- (if (string-match-p "\\`https?:" ,location)
- (url-insert-file-contents (concat ,location ,file))
- (unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
- (insert-file-contents (expand-file-name ,file ,location)))
- ,@body))
-
(cl-defmacro package--with-response-buffer (url &rest body &key async file
error-form noerror &allow-other-keys)
"Access URL and run BODY in a buffer containing the response.
Point is after the headers when BODY runs.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ae2cf8e..07beb72 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -97,11 +97,34 @@
(declare-function get-edebug-spec "edebug" (symbol))
(declare-function edebug-match "edebug" (cursor specs))
+(defun pcase--get-macroexpander (s)
+ "Return the macroexpander for pcase pattern head S, or nil"
+ (let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment))))
+ (if em (cdr em)
+ (get s 'pcase-macroexpander))))
+
+(defmacro pcase-macrolet (bindings &rest body)
+ (let ((new-macros (if (consp (car-safe bindings))
+ (mapcar (lambda (binding)
+ (cons (car binding)
+ (eval (if (cddr binding)
+ `(lambda ,(cadr binding)
+ ,@(cddr binding))
+ (cadr binding))
+ lexical-binding)))
+ bindings)
+ (eval bindings lexical-binding)))
+ (old-pme (assq :pcase-macroexpander macroexpand-all-environment)))
+ (macroexpand-all (macroexp-progn body)
+ (cons (cons :pcase-macroexpander
+ (append new-macros old-pme))
+ macroexpand-all-environment))))
+
(defun pcase--edebug-match-macro (cursor)
(let (specs)
(mapatoms
(lambda (s)
- (let ((m (get s 'pcase-macroexpander)))
+ (let ((m (pcase--get-macroexpander s)))
(when (and m (get-edebug-spec m))
(push (cons (symbol-name s) (get-edebug-spec m))
specs)))))
@@ -193,7 +216,7 @@ Emacs Lisp manual for more information and examples."
(let (more)
;; Collect all the extensions.
(mapatoms (lambda (symbol)
- (let ((me (get symbol 'pcase-macroexpander)))
+ (let ((me (pcase--get-macroexpander symbol)))
(when me
(push (cons symbol me)
more)))))
@@ -419,7 +442,7 @@ of the elements of LIST is performed as if by `pcase-let'.
((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat)))
((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat))))
(t
- (let* ((expander (get head 'pcase-macroexpander))
+ (let* ((expander (pcase--get-macroexpander head))
(npat (if expander (apply expander (cdr pat)))))
(if (null npat)
(error (if expander
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 00f72e2..a9b5df5 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:
(completion-regexp-list nil)
(open (cond ((stringp paren) paren) (paren "\\(")))
(sorted-strings (delete-dups
- (sort (copy-sequence strings) 'string-lessp)))
+ (sort (copy-sequence strings) #'string-lessp)))
(re
(cond
;; No strings: return an unmatchable regexp.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index f2163b2..4726596 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -239,7 +239,7 @@ be either:
;; (exp (exp (or "+" "*" "=" ..) exp)).
;; Basically, make it EBNF (except for the specification of a separator in
;; the repetition, maybe).
- (let* ((nts (mapcar 'car bnf)) ;Non-terminals.
+ (let* ((nts (mapcar #'car bnf)) ;Non-terminals.
(first-ops-table ())
(last-ops-table ())
(first-nts-table ())
@@ -258,7 +258,7 @@ be either:
(push resolver precs))
(t (error "Unknown resolver %S" resolver))))
(apply #'smie-merge-prec2s over
- (mapcar 'smie-precs->prec2 precs))))
+ (mapcar #'smie-precs->prec2 precs))))
again)
(dolist (rules bnf)
(let ((nt (car rules))
@@ -489,7 +489,7 @@ CSTS is a list of pairs representing arcs in a graph."
res))
cycle)))
(mapconcat
- (lambda (elems) (mapconcat 'identity elems "="))
+ (lambda (elems) (mapconcat #'identity elems "="))
(append names (list (car names)))
" < ")))
@@ -559,7 +559,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
;; Then eliminate trivial constraints iteratively.
(let ((i 0))
(while csts
- (let ((rhvs (mapcar 'cdr csts))
+ (let ((rhvs (mapcar #'cdr csts))
(progress nil))
(dolist (cst csts)
(unless (memq (car cst) rhvs)
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index bdb205c..e7c737d 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -293,15 +293,15 @@
;; desirable that viper-pre-command-sentinel is the last hook and
;; viper-post-command-sentinel is the first hook.
- (remove-hook 'post-command-hook 'viper-post-command-sentinel)
- (add-hook 'post-command-hook 'viper-post-command-sentinel)
- (remove-hook 'pre-command-hook 'viper-pre-command-sentinel)
- (add-hook 'pre-command-hook 'viper-pre-command-sentinel t)
+ (remove-hook 'post-command-hook #'viper-post-command-sentinel)
+ (add-hook 'post-command-hook #'viper-post-command-sentinel)
+ (remove-hook 'pre-command-hook #'viper-pre-command-sentinel)
+ (add-hook 'pre-command-hook #'viper-pre-command-sentinel t)
;; These hooks will be added back if switching to insert/replace mode
(remove-hook 'viper-post-command-hooks
- 'viper-insert-state-post-command-sentinel 'local)
+ #'viper-insert-state-post-command-sentinel 'local)
(remove-hook 'viper-pre-command-hooks
- 'viper-insert-state-pre-command-sentinel 'local)
+ #'viper-insert-state-pre-command-sentinel 'local)
(setq viper-intermediate-command nil)
(cond ((eq new-state 'vi-state)
(cond ((member viper-current-state '(insert-state replace-state))
@@ -344,9 +344,9 @@
(viper-move-marker-locally
'viper-last-posn-while-in-insert-state (point))
(add-hook 'viper-post-command-hooks
- 'viper-insert-state-post-command-sentinel t 'local)
+ #'viper-insert-state-post-command-sentinel t 'local)
(add-hook 'viper-pre-command-hooks
- 'viper-insert-state-pre-command-sentinel t 'local))
+ #'viper-insert-state-pre-command-sentinel t 'local))
) ; outermost cond
;; 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."
;; it is an error.
(progn
;; new com is (CHAR . OLDCOM)
- (if (viper-memq-char char '(?# ?\")) (user-error viper-ViperBell))
+ (if (viper-memq-char char '(?# ?\")) (viper--user-error))
(setq com (cons char com))
(setq cont nil))
;; 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."
(let ((reg (read-char)))
(if (viper-valid-register reg)
(setq viper-use-register reg)
- (user-error viper-ViperBell))
+ (viper--user-error))
(setq char (read-char))))
(t
(setq com char)
@@ -1115,7 +1115,7 @@ as a Meta key and any number of multiple escapes are
allowed."
(viper-regsuffix-command-p char)
(viper= char ?!) ; bang command
(viper= char ?g) ; the gg command (like G0)
- (user-error viper-ViperBell))
+ (viper--user-error))
(setq cmd-to-exec-at-end
(viper-exec-form-in-vi
`(key-binding (char-to-string ,char)))))
@@ -1149,7 +1149,7 @@ as a Meta key and any number of multiple escapes are
allowed."
((equal com '(?= . ?=)) (viper-line (cons value ?=)))
;; gg acts as G0
((equal (car com) ?g) (viper-goto-line 0))
- (t (user-error viper-ViperBell)))))
+ (t (viper--user-error)))))
(if cmd-to-exec-at-end
(progn
@@ -1432,23 +1432,25 @@ as a Meta key and any number of multiple escapes are
allowed."
(setq viper-intermediate-command 'viper-exec-buffer-search)
(viper-search viper-s-string viper-s-forward 1))
-(defvar viper-exec-array (make-vector 128 nil))
+(defvar viper-exec-array
+ (let ((a (make-vector 128 nil)))
-;; Using a dispatch array allows adding functions like buffer search
-;; without affecting other functions. Buffer search can now be bound
-;; to any character.
+ ;; Using a dispatch array allows adding functions like buffer search
+ ;; without affecting other functions. Buffer search can now be bound
+ ;; to any character.
-(aset viper-exec-array ?c 'viper-exec-change)
-(aset viper-exec-array ?C 'viper-exec-Change)
-(aset viper-exec-array ?d 'viper-exec-delete)
-(aset viper-exec-array ?D 'viper-exec-Delete)
-(aset viper-exec-array ?y 'viper-exec-yank)
-(aset viper-exec-array ?Y 'viper-exec-Yank)
-(aset viper-exec-array ?r 'viper-exec-dummy)
-(aset viper-exec-array ?! 'viper-exec-bang)
-(aset viper-exec-array ?< 'viper-exec-shift)
-(aset viper-exec-array ?> 'viper-exec-shift)
-(aset viper-exec-array ?= 'viper-exec-equals)
+ (aset a ?c 'viper-exec-change)
+ (aset a ?C 'viper-exec-Change)
+ (aset a ?d 'viper-exec-delete)
+ (aset a ?D 'viper-exec-Delete)
+ (aset a ?y 'viper-exec-yank)
+ (aset a ?Y 'viper-exec-Yank)
+ (aset a ?r 'viper-exec-dummy)
+ (aset a ?! 'viper-exec-bang)
+ (aset a ?< 'viper-exec-shift)
+ (aset a ?> 'viper-exec-shift)
+ (aset a ?= 'viper-exec-equals)
+ a))
@@ -1587,7 +1589,7 @@ invokes the command before that, etc."
(defun viper-undo-sentinel (beg end length)
(run-hook-with-args 'viper-undo-functions beg end length))
-(add-hook 'after-change-functions 'viper-undo-sentinel)
+(add-hook 'after-change-functions #'viper-undo-sentinel)
;; Hook used in viper-undo
(defun viper-after-change-undo-hook (beg end _len)
@@ -1597,7 +1599,7 @@ invokes the command before that, etc."
;; some other hooks may be changing various text properties in
;; the buffer in response to 'undo'; so remove this hook to avoid
;; its repeated invocation
- (remove-hook 'viper-undo-functions 'viper-after-change-undo-hook 'local)
+ (remove-hook 'viper-undo-functions #'viper-after-change-undo-hook 'local)
))
(defun viper-undo ()
@@ -1608,7 +1610,7 @@ invokes the command before that, etc."
undo-beg-posn undo-end-posn)
;; the viper-after-change-undo-hook removes itself after the 1st invocation
- (add-hook 'viper-undo-functions 'viper-after-change-undo-hook nil 'local)
+ (add-hook 'viper-undo-functions #'viper-after-change-undo-hook nil 'local)
(undo-start)
(undo-more 2)
@@ -1880,8 +1882,8 @@ Undo previous insertion and inserts new."
;;; Minibuffer business
(defsubst viper-set-minibuffer-style ()
- (add-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
- (add-hook 'post-command-hook 'viper-minibuffer-post-command-hook))
+ (add-hook 'minibuffer-setup-hook #'viper-minibuffer-setup-sentinel)
+ (add-hook 'post-command-hook #'viper-minibuffer-post-command-hook))
(defun viper-minibuffer-setup-sentinel ()
@@ -2227,22 +2229,22 @@ problems."
viper-sitting-in-replace t
viper-replace-chars-to-delete 0)
(add-hook
- 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local)
+ 'viper-after-change-functions #'viper-replace-mode-spy-after t 'local)
(add-hook
- 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local)
+ 'viper-before-change-functions #'viper-replace-mode-spy-before t 'local)
;; this will get added repeatedly, but no harm
- (add-hook 'after-change-functions 'viper-after-change-sentinel t)
- (add-hook 'before-change-functions 'viper-before-change-sentinel t)
+ (add-hook 'after-change-functions #'viper-after-change-sentinel t)
+ (add-hook 'before-change-functions #'viper-before-change-sentinel t)
(viper-move-marker-locally
'viper-last-posn-in-replace-region (viper-replace-start))
(add-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
t 'local)
(add-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t
'local)
;; guard against a smarty who switched from R-replace to normal replace
(remove-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
(if overwrite-mode (overwrite-mode -1))
)
@@ -2316,13 +2318,13 @@ problems."
;; Don't delete anything if current point is past the end of the overlay.
(defun viper-finish-change ()
(remove-hook
- 'viper-after-change-functions 'viper-replace-mode-spy-after 'local)
+ 'viper-after-change-functions #'viper-replace-mode-spy-after 'local)
(remove-hook
- 'viper-before-change-functions 'viper-replace-mode-spy-before 'local)
+ 'viper-before-change-functions #'viper-replace-mode-spy-before 'local)
(remove-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
'local)
(remove-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
(viper-restore-cursor-color 'after-replace-mode)
(setq viper-sitting-in-replace nil) ; just in case we'll need to know it
(save-excursion
@@ -2352,21 +2354,21 @@ problems."
(defun viper-finish-R-mode ()
(remove-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel 'local)
(remove-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel 'local)
(viper-downgrade-to-insert))
(defun viper-start-R-mode ()
;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
(overwrite-mode 1)
(add-hook
- 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local)
+ 'viper-post-command-hooks #'viper-R-state-post-command-sentinel t 'local)
(add-hook
- 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
+ 'viper-pre-command-hooks #'viper-replace-state-pre-command-sentinel t
'local)
;; guard against a smarty who switched from R-replace to normal replace
(remove-hook
- 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
+ 'viper-post-command-hooks #'viper-replace-state-post-command-sentinel
'local)
)
@@ -2541,9 +2543,9 @@ On reaching end of line, stop and signal error."
;; the forward motion before the 'viper-execute-com', but, of
;; course, 'dl' doesn't work on an empty line, so we have to
;; catch that condition before 'viper-execute-com'
- (if (and (eolp) (bolp)) (user-error viper-ViperBell) (forward-char
val))
+ (if (and (eolp) (bolp)) (viper--user-error) (forward-char val))
(if com (viper-execute-com 'viper-forward-char val com))
- (if (eolp) (progn (backward-char 1) (user-error viper-ViperBell))))
+ (if (eolp) (progn (backward-char 1) (viper--user-error))))
(forward-char val)
(if com (viper-execute-com 'viper-forward-char val com)))))
@@ -2557,7 +2559,7 @@ On reaching beginning of line, stop and signal error."
(if com (viper-move-marker-locally 'viper-com-point (point)))
(if viper-ex-style-motion
(progn
- (if (bolp) (user-error viper-ViperBell) (backward-char val))
+ (if (bolp) (viper--user-error) (backward-char val))
(if com (viper-execute-com 'viper-backward-char val com)))
(backward-char val)
(if com (viper-execute-com 'viper-backward-char val com)))))
@@ -2874,7 +2876,7 @@ On reaching beginning of line, stop and signal error."
(if com (viper-execute-com 'viper-goto-col val com))
(save-excursion
(end-of-line)
- (if (> val (current-column)) (user-error viper-ViperBell)))
+ (if (> val (current-column)) (viper--user-error)))
))
@@ -3001,7 +3003,7 @@ If point is on a widget or a button, simulate clicking on
that widget/button."
;; If FORWARD then search is forward, otherwise backward. OFFSET is used to
;; adjust point after search.
(defun viper-find-char (arg char forward offset)
- (or (char-or-string-p char) (user-error viper-ViperBell))
+ (or (char-or-string-p char) (viper--user-error))
(let ((arg (if forward arg (- arg)))
(cmd (if (eq viper-intermediate-command 'viper-repeat)
(nth 5 viper-d-com)
@@ -3335,7 +3337,7 @@ controlled by the sign of prefix numeric value."
(if com (viper-move-marker-locally 'viper-com-point (point)))
(backward-sexp 1)
(if com (viper-execute-com 'viper-paren-match nil com)))
- (t (user-error viper-ViperBell))))))
+ (t (viper--user-error))))))
(defun viper-toggle-parse-sexp-ignore-comments ()
(interactive)
@@ -3906,7 +3908,7 @@ Null string will repeat previous search."
(let ((reg viper-use-register))
(setq viper-use-register nil)
(error viper-EmptyRegister reg))
- (user-error viper-ViperBell)))
+ (viper--user-error)))
(setq viper-use-register nil)
(if (viper-end-with-a-newline-p text)
(progn
@@ -3956,7 +3958,7 @@ Null string will repeat previous search."
(let ((reg viper-use-register))
(setq viper-use-register nil)
(error viper-EmptyRegister reg))
- (user-error viper-ViperBell)))
+ (viper--user-error)))
(setq viper-use-register nil)
(if (viper-end-with-a-newline-p text) (beginning-of-line))
(viper-set-destructive-command
@@ -4001,7 +4003,7 @@ Null string will repeat previous search."
(> val (viper-chars-in-region (point) (viper-line-pos 'end))))
(setq val (viper-chars-in-region (point) (viper-line-pos 'end))))
(if (and viper-ex-style-motion (eolp))
- (if (bolp) (user-error viper-ViperBell) (setq val 0))) ; not
bol---simply back 1 ch
+ (if (bolp) (viper--user-error) (setq val 0))) ; not bol---simply back 1
ch
(save-excursion
(viper-forward-char-carefully val)
(setq end-del-pos (point)))
@@ -4271,7 +4273,7 @@ and regexp replace."
((viper= char ?,) (viper-cycle-through-mark-ring))
((viper= char ?^) (push-mark viper-saved-mark t t))
((viper= char ?D) (mark-defun))
- (t (user-error viper-ViperBell))
+ (t (viper--user-error))
)))
;; Algorithm: If first invocation of this command save mark on ring, goto
@@ -4370,7 +4372,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1
step back."
(switch-to-buffer buff)
(goto-char viper-com-point)
(viper-change-state-to-vi)
- (user-error viper-ViperBell)))))
+ (viper--user-error)))))
((and (not skip-white) (viper= char ?`))
(if com (viper-move-marker-locally 'viper-com-point (point)))
(if (and (viper-same-line (point) viper-last-jump)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 26bca68..7aa3333 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1239,7 +1239,7 @@ reversed."
(read-string "[Hit return to confirm] ")
(quit
(save-excursion (kill-buffer " *delete text*"))
- (user-error viper-ViperBell)))
+ (viper--user-error)))
(save-excursion (kill-buffer " *delete text*")))
(if ex-buffer
(cond ((viper-valid-register ex-buffer '(Letter))
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 1d7bb15..2af9497 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -64,6 +64,8 @@
(define-obsolete-function-alias 'viper-iconify
'iconify-or-deiconify-frame "27.1")
+(defun viper--user-error () (user-error "Viper bell"))
+(defun viper--user-error () (user-error "Viper bell"))
;; CHAR is supposed to be a char or an integer (positive or negative)
;; 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 53a5920..bdce91f 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -536,17 +536,17 @@ keybindings will not do anything useful."
((when (boundp 'erc-track-when-inactive)
(if erc-track-when-inactive
(progn
- (add-hook 'window-configuration-change-hook 'erc-user-is-active)
- (add-hook 'erc-send-completed-hook 'erc-user-is-active)
- (add-hook 'erc-server-001-functions 'erc-user-is-active))
+ (add-hook 'window-configuration-change-hook #'erc-user-is-active)
+ (add-hook 'erc-send-completed-hook #'erc-user-is-active)
+ (add-hook 'erc-server-001-functions #'erc-user-is-active))
(erc-track-add-to-mode-line erc-track-position-in-mode-line)
(erc-update-mode-line)
(add-hook 'window-configuration-change-hook
- 'erc-window-configuration-change)
- (add-hook 'erc-insert-post-hook 'erc-track-modified-channels)
- (add-hook 'erc-disconnected-hook 'erc-modified-channels-update))
+ #'erc-window-configuration-change)
+ (add-hook 'erc-insert-post-hook #'erc-track-modified-channels)
+ (add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
;; enable the tracking keybindings
- (add-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
+ (add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
(erc-track-minor-mode-maybe)))
;; Disable:
((when (boundp 'erc-track-when-inactive)
@@ -554,14 +554,15 @@ keybindings will not do anything useful."
(if erc-track-when-inactive
(progn
(remove-hook 'window-configuration-change-hook
- 'erc-user-is-active)
- (remove-hook 'erc-send-completed-hook 'erc-user-is-active)
- (remove-hook 'erc-server-001-functions 'erc-user-is-active)
- (remove-hook 'erc-timer-hook 'erc-user-is-active))
+ #'erc-user-is-active)
+ (remove-hook 'erc-send-completed-hook #'erc-user-is-active)
+ (remove-hook 'erc-server-001-functions #'erc-user-is-active)
+ ;; FIXME: Never added!?
+ (remove-hook 'erc-timer-hook #'erc-user-is-active))
(remove-hook 'window-configuration-change-hook
- 'erc-window-configuration-change)
- (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update)
- (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels))
+ #'erc-window-configuration-change)
+ (remove-hook 'erc-disconnected-hook #'erc-modified-channels-update)
+ (remove-hook 'erc-insert-post-hook #'erc-track-modified-channels))
;; disable the tracking keybindings
(remove-hook 'erc-connect-pre-hook 'erc-track-minor-mode-maybe)
(when erc-track-minor-mode
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f5c9dec..0b0cc04 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."
;; obsolete, and when it's finally removed, this binding should
;; also be removed.
(with-suppressed-warnings ((lexical str))
- (defvar str))
+ (defvar str)) ;FIXME: Obey the "erc-" prefix convention.
(let ((str input)
(erc-insert-this t)
(erc-send-this t)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index fe8eb35..96e9536 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -306,8 +306,7 @@ Prepend remote identification of `default-directory', if
any."
(setq m (cdr m))))
l)
(define-obsolete-function-alias
- 'eshell-uniqify-list
- 'eshell-uniquify-list "27.1")
+ 'eshell-uniqify-list #'eshell-uniquify-list "27.1")
(defun eshell-stringify (object)
"Convert OBJECT into a string value."
@@ -326,11 +325,11 @@ Prepend remote identification of `default-directory', if
any."
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
- (mapcar 'eshell-stringify args))
+ (mapcar #'eshell-stringify args))
(defsubst eshell-flatten-and-stringify (&rest args)
"Flatten and stringify all of the ARGS into a single string."
- (mapconcat 'eshell-stringify (flatten-tree args) " "))
+ (mapconcat #'eshell-stringify (flatten-tree args) " "))
(defsubst eshell-directory-files (regexp &optional directory)
"Return a list of files in the given DIRECTORY matching REGEXP."
@@ -526,7 +525,7 @@ Unless optional argument INPLACE is non-nil, return a new
string."
(defsubst eshell-copy-environment ()
"Return an unrelated copy of `process-environment'."
- (mapcar 'concat process-environment))
+ (mapcar #'concat process-environment))
(defun eshell-subgroups (groupsym)
"Return all of the subgroups of GROUPSYM."
diff --git a/lisp/follow.el b/lisp/follow.el
index acc2b26..e570fff 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -117,7 +117,7 @@
;; `follow-mode'.
;;
;; Example:
-;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
+;; (add-hook 'follow-mode-hook #'my-follow-mode-hook)
;;
;; (defun my-follow-mode-hook ()
;; (define-key follow-mode-map "\C-ca" 'your-favorite-function)
@@ -307,8 +307,8 @@ are \" Fw\", or simply \"\"."
:group 'follow
:set (lambda (symbol value)
(if value
- (add-hook 'find-file-hook 'follow-find-file-hook t)
- (remove-hook 'find-file-hook 'follow-find-file-hook))
+ (add-hook 'find-file-hook #'follow-find-file-hook t)
+ (remove-hook 'find-file-hook #'follow-find-file-hook))
(set-default symbol value)))
(defcustom follow-hide-ghost-cursors t ; Maybe this should be nil.
@@ -370,7 +370,7 @@ This is typically set by explicit scrolling commands.")
(defsubst follow-debug-message (&rest args)
"Like `message', but only active when `follow-debug' is non-nil."
(if (and (boundp 'follow-debug) follow-debug)
- (apply 'message args)))
+ (apply #'message args)))
;;; Cache
@@ -428,27 +428,28 @@ Keys specific to Follow mode:
:keymap follow-mode-map
(if follow-mode
(progn
- (add-hook 'compilation-filter-hook 'follow-align-compilation-windows t
t)
- (add-function :before pre-redisplay-function
'follow-pre-redisplay-function)
- (add-hook 'window-size-change-functions 'follow-window-size-change t)
- (add-hook 'after-change-functions 'follow-after-change nil t)
- (add-hook 'isearch-update-post-hook 'follow-post-command-hook nil t)
- (add-hook 'replace-update-post-hook 'follow-post-command-hook nil t)
- (add-hook 'ispell-update-post-hook 'follow-post-command-hook nil t)
+ (add-hook 'compilation-filter-hook
+ #'follow-align-compilation-windows t t)
+ (add-function :before pre-redisplay-function
#'follow-pre-redisplay-function)
+ (add-hook 'window-size-change-functions #'follow-window-size-change t)
+ (add-hook 'after-change-functions #'follow-after-change nil t)
+ (add-hook 'isearch-update-post-hook #'follow-post-command-hook nil t)
+ (add-hook 'replace-update-post-hook #'follow-post-command-hook nil t)
+ (add-hook 'ispell-update-post-hook #'follow-post-command-hook nil t)
(when isearch-lazy-highlight
(setq-local isearch-lazy-highlight 'all-windows))
(when follow-hide-ghost-cursors
(setq-local cursor-in-non-selected-windows nil))
- (setq window-group-start-function 'follow-window-start)
- (setq window-group-end-function 'follow-window-end)
- (setq set-window-group-start-function 'follow-set-window-start)
- (setq recenter-window-group-function 'follow-recenter)
+ (setq window-group-start-function #'follow-window-start)
+ (setq window-group-end-function #'follow-window-end)
+ (setq set-window-group-start-function #'follow-set-window-start)
+ (setq recenter-window-group-function #'follow-recenter)
(setq pos-visible-in-window-group-p-function
- 'follow-pos-visible-in-window-p)
- (setq selected-window-group-function 'follow-all-followers)
- (setq move-to-window-group-line-function 'follow-move-to-window-line))
+ #'follow-pos-visible-in-window-p)
+ (setq selected-window-group-function #'follow-all-followers)
+ (setq move-to-window-group-line-function #'follow-move-to-window-line))
;; Remove globally-installed hook functions only if there is no
;; other Follow mode buffer.
@@ -458,8 +459,8 @@ Keys specific to Follow mode:
(setq following (buffer-local-value 'follow-mode (car buffers))
buffers (cdr buffers)))
(unless following
- (remove-function pre-redisplay-function 'follow-pre-redisplay-function)
- (remove-hook 'window-size-change-functions 'follow-window-size-change)))
+ (remove-function pre-redisplay-function
#'follow-pre-redisplay-function)
+ (remove-hook 'window-size-change-functions
#'follow-window-size-change)))
(kill-local-variable 'move-to-window-group-line-function)
(kill-local-variable 'selected-window-group-function)
@@ -471,11 +472,11 @@ Keys specific to Follow mode:
(kill-local-variable 'cursor-in-non-selected-windows)
- (remove-hook 'ispell-update-post-hook 'follow-post-command-hook t)
- (remove-hook 'replace-update-post-hook 'follow-post-command-hook t)
- (remove-hook 'isearch-update-post-hook 'follow-post-command-hook t)
- (remove-hook 'after-change-functions 'follow-after-change t)
- (remove-hook 'compilation-filter-hook 'follow-align-compilation-windows
t)))
+ (remove-hook 'ispell-update-post-hook #'follow-post-command-hook t)
+ (remove-hook 'replace-update-post-hook #'follow-post-command-hook t)
+ (remove-hook 'isearch-update-post-hook #'follow-post-command-hook t)
+ (remove-hook 'after-change-functions #'follow-after-change t)
+ (remove-hook 'compilation-filter-hook #'follow-align-compilation-windows
t)))
(defun follow-find-file-hook ()
"Find-file hook for Follow mode. See the variable `follow-auto'."
@@ -1051,16 +1052,16 @@ returned by `follow-windows-start-end'."
(defun follow-select-if-visible (dest win-start-end)
"Select and return a window, if DEST is visible in it.
Return the selected window."
- (let (win wse)
+ (let (win)
(while (and (not win) win-start-end)
;; Don't select a window that was just moved. This makes it
;; possible to later select the last window after a
;; `end-of-buffer' command.
- (setq wse (car win-start-end))
- (when (follow-pos-visible dest (car wse) win-start-end)
- (setq win (car wse))
- (select-window win))
- (setq win-start-end (cdr win-start-end)))
+ (let ((wse (car win-start-end)))
+ (when (follow-pos-visible dest (car wse) win-start-end)
+ (setq win (car wse))
+ (select-window win))
+ (setq win-start-end (cdr win-start-end))))
win))
;; Lets select a window showing the end. Make sure we only select it if
@@ -1217,29 +1218,29 @@ should be a member of WINDOWS, starts at position
START."
(setq win (or win (selected-window)))
(setq start (or start (window-start win)))
(save-excursion
- (let (done win-start res opoint)
- ;; Always calculate what happens when no line is displayed in the first
- ;; window. (The `previous' res is needed below!)
- (goto-char guess)
- (vertical-motion 0 (car windows))
- (setq res (point))
+ ;; Always calculate what happens when no line is displayed in the first
+ ;; window. (The `previous' res is needed below!)
+ (goto-char guess)
+ (vertical-motion 0 (car windows))
+ (let ((res (point))
+ done)
(while (not done)
- (setq opoint (point))
- (if (not (= (vertical-motion -1 (car windows)) -1))
- ;; Hit roof!
- (setq done t res (point-min))
- (setq win-start (follow-calc-win-start windows (point) win))
- (cond ((>= (point) opoint)
- ;; In some pathological cases, vertical-motion may
- ;; return -1 even though point has not decreased. In
- ;; that case, avoid looping forever.
- (setq done t res (point)))
- ((= win-start start) ; Perfect match, use this value
- (setq done t res (point)))
- ((< win-start start) ; Walked to far, use previous result
- (setq done t))
- (t ; Store result for next iteration
- (setq res (point))))))
+ (let ((opoint (point)))
+ (if (not (= (vertical-motion -1 (car windows)) -1))
+ ;; Hit roof!
+ (setq done t res (point-min))
+ (let ((win-start (follow-calc-win-start windows (point) win)))
+ (cond ((>= (point) opoint)
+ ;; In some pathological cases, vertical-motion may
+ ;; return -1 even though point has not decreased. In
+ ;; that case, avoid looping forever.
+ (setq done t res (point)))
+ ((= win-start start) ; Perfect match, use this value
+ (setq done t res (point)))
+ ((< win-start start) ; Walked to far, use previous result
+ (setq done t))
+ (t ; Store result for next iteration
+ (setq res (point))))))))
res)))
;;; Avoid tail recenter
@@ -1316,6 +1317,8 @@ follow-mode is not necessarily enabled in this buffer.")
;; Work in the selected window, not in the current buffer.
(with-current-buffer (window-buffer win)
(unless (and (symbolp this-command)
+ ;; FIXME: Why not compare buffer-modified-tick and
+ ;; selected-window to their old value, instead?
(get this-command 'follow-mode-use-cache))
(setq follow-windows-start-end-cache nil))
(follow-adjust-window win)))))
@@ -1323,7 +1326,7 @@ follow-mode is not necessarily enabled in this buffer.")
;; NOTE: to debug follow-mode with edebug, it is helpful to add
;; `follow-post-command-hook' to `post-command-hook' temporarily. Do
;; this locally to the target buffer with, say,:
-;; M-: (add-hook 'post-command-hook 'follow-post-command-hook t t)
+;; M-: (add-hook 'post-command-hook #'follow-post-command-hook t t)
;; .
(defun follow-adjust-window (win)
@@ -1511,15 +1514,12 @@ follow-mode is not necessarily enabled in this buffer.")
"Make a highlighted region stretching multiple windows look good."
(let* ((all (follow-split-followers windows win))
(pred (car all))
- (succ (cdr all))
- data)
- (while pred
- (setq data (assq (car pred) win-start-end))
- (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
- (setq pred (cdr pred)))
- (while succ
- (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
- (setq succ (cdr succ)))))
+ (succ (cdr all)))
+ (dolist (w pred)
+ (let ((data (assq w win-start-end)))
+ (set-window-point w (max (nth 1 data) (- (nth 2 data) 1)))))
+ (dolist (w succ)
+ (set-window-point w (nth 1 (assq w win-start-end))))))
;;; Scroll bar
@@ -1616,7 +1616,7 @@ follow-mode is not necessarily enabled in this buffer.")
(select-window picked-window 'norecord)))
(select-frame orig-frame)))))
-(add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t)
+(add-hook 'window-scroll-functions #'follow-avoid-tail-recenter t)
;;; Low level window start and end.
@@ -1690,9 +1690,8 @@ of the actual window containing it. The remaining
elements are
omitted if the character after POS is fully visible; otherwise, RTOP
and RBOT are the number of pixels off-window at the top and bottom of
the screen line (\"row\") containing POS, ROWH is the visible height
-of that row, and VPOS is the row number \(zero-based)."
- (let* ((windows (follow-all-followers window))
- (last (car (last windows))))
+of that row, and VPOS is the row number (zero-based)."
+ (let* ((windows (follow-all-followers window)))
(when follow-start-end-invalid
(follow-redisplay windows (car windows)))
(let* ((cache (follow-windows-start-end windows))
@@ -1703,10 +1702,9 @@ of that row, and VPOS is the row number \(zero-based)."
last-elt
(setq our-pos (or pos (point)))
(catch 'element
- (while cache
- (when (< our-pos (nth 2 (car cache)))
- (throw 'element (car cache)))
- (setq cache (cdr cache)))
+ (dolist (ce cache)
+ (when (< our-pos (nth 2 ce))
+ (throw 'element ce)))
last-elt)))
(pos-visible-in-window-p our-pos (car pertinent-elt) partially))))
@@ -1720,7 +1718,7 @@ zero means top of the first window in the group, negative
means
(start-end (follow-windows-start-end windows))
(rev-start-end (reverse start-end))
(lines 0)
- middle-window elt count)
+ elt count)
(select-window
(cond
((null arg)
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 4455c59..e290a27 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -1,4 +1,4 @@
-;;; format-spec.el --- functions for formatting arbitrary formatting strings
+;;; format-spec.el --- functions for formatting arbitrary formatting strings
-*- lexical-binding:t -*-
;; Copyright (C) 1999-2019 Free Software Foundation, Inc.
diff --git a/lisp/frame.el b/lisp/frame.el
index 9402c15..87bf058 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -26,6 +26,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x)) ;For string-trim-right
(cl-defgeneric frame-creation-function (params)
"Method for window-system dependent functions to create a new frame.
@@ -2501,14 +2502,34 @@ command starts, by installing a pre-command hook."
(when (and (> blink-cursor-blinks 0)
(<= (* 2 blink-cursor-blinks) blink-cursor-blinks-done))
(blink-cursor-suspend)
- (add-hook 'post-command-hook 'blink-cursor-check)))
+ (add-hook 'post-command-hook #'blink-cursor-check))
+ ;; FIXME: Under TTYs, apparently redisplay only obeys internal-show-cursor
+ ;; when there is something else to update on the screen. This is arguably
+ ;; a bug, but in the meantime we can circumvent it here by causing an
+ ;; artificial update which thus "forces" a cursor update.
+ (when (null window-system)
+ (let* ((message-log-max nil)
+ (msg (current-message))
+ ;; Construct a dummy temp message different from the current one.
+ ;; This message usually flashes by too quickly to be visible, but
+ ;; occasionally it can be noticed, so make it "inconspicuous".
+ ;; Not too "inconspicuous", tho: just adding or removing a SPC at
the
+ ;; end doesn't cause an update, for example.
+ (dummymsg (concat (if (> (length msg) 40)
+ (let ((msg (string-trim-right msg)))
+ (if (> (length msg) 2)
+ (substring msg 0 -2)
+ msg))
+ msg) "-")))
+ (message "%s" dummymsg)
+ (if msg (message "%s" msg) (message nil)))))
(defun blink-cursor-end ()
"Stop cursor blinking.
This is installed as a pre-command hook by `blink-cursor-start'.
When run, it cancels the timer `blink-cursor-timer' and removes
itself as a pre-command hook."
- (remove-hook 'pre-command-hook 'blink-cursor-end)
+ (remove-hook 'pre-command-hook #'blink-cursor-end)
(internal-show-cursor nil t)
(when blink-cursor-timer
(cancel-timer blink-cursor-timer)
@@ -2527,15 +2548,7 @@ frame receives focus."
(defun blink-cursor--should-blink ()
"Determine whether we should be blinking.
Returns whether we have any focused non-TTY frame."
- (and blink-cursor-mode
- (let ((frame-list (frame-list))
- (any-graphical-focused nil))
- (while frame-list
- (let ((frame (pop frame-list)))
- (when (and (display-graphic-p frame) (frame-focus-state frame))
- (setf any-graphical-focused t)
- (setf frame-list nil))))
- any-graphical-focused)))
+ blink-cursor-mode)
(defun blink-cursor-check ()
"Check if cursor blinking shall be restarted.
@@ -2544,7 +2557,7 @@ stopped by `blink-cursor-suspend'. Internally calls
`blink-cursor--should-blink' and returns its result."
(let ((should-blink (blink-cursor--should-blink)))
(when (and should-blink (not blink-cursor-idle-timer))
- (remove-hook 'post-command-hook 'blink-cursor-check)
+ (remove-hook 'post-command-hook #'blink-cursor-check)
(blink-cursor--start-idle-timer))
should-blink))
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index d826fac..6b5a21e 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."
:group 'gnus-article
:type 'boolean)
-(defcustom gnus-blocked-images 'gnus-block-private-groups
+(defcustom gnus-blocked-images #'gnus-block-private-groups
"Images that have URLs matching this regexp will be blocked.
Note that the main reason external images are included in HTML
emails (these days) is to allow tracking whether you've read the
@@ -2693,7 +2693,7 @@ If READ-CHARSET, ask for a coding system."
"Format an HTML article."
(interactive)
(let ((handles nil)
- (buffer-read-only nil))
+ (inhibit-read-only t))
(when (gnus-buffer-live-p gnus-original-article-buffer)
(with-current-buffer gnus-original-article-buffer
(setq handles (mm-dissect-buffer t t))))
@@ -4302,71 +4302,67 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(canlock-verify gnus-original-article-buffer)))
(eval-and-compile
- (mapc
- (lambda (func)
- (let (afunc gfunc)
- (if (consp func)
- (setq afunc (car func)
- gfunc (cdr func))
- (setq afunc func
- gfunc (intern (format "gnus-%s" func))))
- (defalias gfunc
- (when (fboundp afunc)
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (with-current-buffer gnus-article-buffer
- (if interactive
- (call-interactively ',afunc)
- (apply #',afunc args))))))))
- '(article-hide-headers
- article-verify-x-pgp-sig
- article-verify-cancel-lock
- article-hide-boring-headers
- article-treat-overstrike
- article-treat-ansi-sequences
- article-fill-long-lines
- article-capitalize-sentences
- article-remove-cr
- article-remove-leading-whitespace
- article-display-x-face
- article-display-face
- article-de-quoted-unreadable
- article-de-base64-unreadable
- article-decode-HZ
- article-wash-html
- article-unsplit-urls
- article-hide-list-identifiers
- article-strip-banner
- article-babel
- article-hide-pem
- article-hide-signature
- article-strip-headers-in-body
- article-remove-trailing-blank-lines
- article-strip-leading-blank-lines
- article-strip-multiple-blank-lines
- article-strip-leading-space
- article-strip-trailing-space
- article-strip-blank-lines
- article-strip-all-blank-lines
- article-date-local
- article-date-english
- article-date-iso8601
- article-date-original
- article-treat-date
- article-date-ut
- article-decode-mime-words
- article-decode-charset
- article-decode-encoded-words
- article-date-user
- article-date-lapsed
- article-date-combined-lapsed
- article-emphasize
- article-treat-dumbquotes
- article-treat-non-ascii
- article-normalize-headers
- ;;(article-show-all . gnus-article-show-all-headers)
- )))
+ (defmacro gnus-art-defun (gnus-fun &optional article-fun)
+ "Define GNUS-FUN as a function that runs ARTICLE-FUN in the article
buffer."
+ (unless article-fun
+ (if (not (string-match "\\`gnus-" (symbol-name gnus-fun)))
+ (error "Can't guess article-fun argument")
+ (setq article-fun (intern (substring (symbol-name gnus-fun)
+ (match-end 0))))))
+ `(defun ,gnus-fun (&optional interactive &rest args)
+ ,(format "Run `%s' in the article buffer." article-fun)
+ (interactive (list t))
+ (with-current-buffer gnus-article-buffer
+ (if interactive
+ (call-interactively ',article-fun)
+ (apply #',article-fun args))))))
+(gnus-art-defun gnus-article-hide-headers)
+(gnus-art-defun gnus-article-verify-x-pgp-sig)
+(gnus-art-defun gnus-article-verify-cancel-lock)
+(gnus-art-defun gnus-article-hide-boring-headers)
+(gnus-art-defun gnus-article-treat-overstrike)
+(gnus-art-defun gnus-article-treat-ansi-sequences)
+(gnus-art-defun gnus-article-fill-long-lines)
+(gnus-art-defun gnus-article-capitalize-sentences)
+(gnus-art-defun gnus-article-remove-cr)
+(gnus-art-defun gnus-article-remove-leading-whitespace)
+(gnus-art-defun gnus-article-display-x-face)
+(gnus-art-defun gnus-article-display-face)
+(gnus-art-defun gnus-article-de-quoted-unreadable)
+(gnus-art-defun gnus-article-de-base64-unreadable)
+(gnus-art-defun gnus-article-decode-HZ)
+(gnus-art-defun gnus-article-wash-html)
+(gnus-art-defun gnus-article-unsplit-urls)
+(gnus-art-defun gnus-article-hide-list-identifiers)
+(gnus-art-defun gnus-article-strip-banner)
+(gnus-art-defun gnus-article-babel)
+(gnus-art-defun gnus-article-hide-pem)
+(gnus-art-defun gnus-article-hide-signature)
+(gnus-art-defun gnus-article-strip-headers-in-body)
+(gnus-art-defun gnus-article-remove-trailing-blank-lines)
+(gnus-art-defun gnus-article-strip-leading-blank-lines)
+(gnus-art-defun gnus-article-strip-multiple-blank-lines)
+(gnus-art-defun gnus-article-strip-leading-space)
+(gnus-art-defun gnus-article-strip-trailing-space)
+(gnus-art-defun gnus-article-strip-blank-lines)
+(gnus-art-defun gnus-article-strip-all-blank-lines)
+(gnus-art-defun gnus-article-date-local)
+(gnus-art-defun gnus-article-date-english)
+(gnus-art-defun gnus-article-date-iso8601)
+(gnus-art-defun gnus-article-date-original)
+(gnus-art-defun gnus-article-treat-date)
+(gnus-art-defun gnus-article-date-ut)
+(gnus-art-defun gnus-article-decode-mime-words)
+(gnus-art-defun gnus-article-decode-charset)
+(gnus-art-defun gnus-article-decode-encoded-words)
+(gnus-art-defun gnus-article-date-user)
+(gnus-art-defun gnus-article-date-lapsed)
+(gnus-art-defun gnus-article-date-combined-lapsed)
+(gnus-art-defun gnus-article-emphasize)
+(gnus-art-defun gnus-article-treat-dumbquotes)
+(gnus-art-defun gnus-article-treat-non-ascii)
+(gnus-art-defun gnus-article-normalize-headers)
+;;(gnus-art-defun gnus-article-show-all-headers article-show-all)
;;;
;;; Gnus article mode
@@ -4869,17 +4865,18 @@ General format specifiers can also be used. See Info
node
(defvar gnus-mime-button-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-2] 'gnus-article-push-button)
- (define-key map [down-mouse-3] 'gnus-mime-button-menu)
(dolist (c gnus-mime-button-commands)
(define-key map (cadr c) (car c)))
- map))
-(easy-menu-define
- gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
- `("MIME Part"
- ,@(mapcar (lambda (c)
- (vector (caddr c) (car c) :active t))
- gnus-mime-button-commands)))
+ (easy-menu-define gnus-mime-button-menu map "MIME button menu."
+ `("MIME Part"
+ ,@(mapcar (lambda (c)
+ (vector (caddr c) (car c) :active t))
+ gnus-mime-button-commands)))
+
+ (define-key map [down-mouse-3]
+ (easy-menu-binding gnus-mime-button-menu))
+ map))
(defvar gnus-url-button-commands
'((gnus-article-copy-string "u" "Copy URL to kill ring")))
@@ -4923,16 +4920,6 @@ General format specifiers can also be used. See Info
node
(setq mm-w3m-safe-url-regexp nil)))
,@body))
-(defun gnus-mime-button-menu (event prefix)
- "Construct a context-sensitive menu of MIME commands."
- (interactive "e\nP")
- (save-window-excursion
- (let ((pos (event-start event)))
- (select-window (posn-window pos))
- (goto-char (posn-point pos))
- (gnus-article-check-buffer)
- (popup-menu gnus-mime-button-menu nil prefix))))
-
(defun gnus-mime-view-all-parts (&optional handles)
"View all the MIME parts."
(interactive)
@@ -5055,10 +5042,12 @@ and `gnus-mime-delete-part', and not provided at
run-time normally."
nil nil)))
(gnus-mime-save-part-and-strip file))
-(defun gnus-mime-save-part-and-strip (&optional file)
+(defun gnus-mime-save-part-and-strip (&optional file event)
"Save the MIME part under point then replace it with an external body.
If FILE is given, use it for the external part."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
(error "The current group does not support deleting of parts"))
@@ -5090,15 +5079,16 @@ The current article has a complicated MIME structure,
giving up..."))
(access-type . "LOCAL-FILE")
(name . ,file)))))
;; (set-buffer gnus-summary-buffer)
- (gnus-article-edit-part handles id))))
+ (gnus-article-edit-part handles id)))))
;; A function like `gnus-summary-save-parts' (`X m', `<MIME> <Extract all
;; parts...>') but with stripping would be nice.
-(defun gnus-mime-delete-part ()
+(defun gnus-mime-delete-part (&optional event)
"Delete the MIME part under point.
Replace it with some information about the removed part."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(when (gnus-group-read-only-p)
(error "The current group does not support deleting of parts"))
@@ -5144,33 +5134,36 @@ Deleting parts may malfunction or destroy the article;
continue? "))
;; (set-buffer gnus-summary-buffer)
(gnus-article-edit-part handles id))))
-(defun gnus-mime-save-part ()
+(defun gnus-mime-save-part (&optional event)
"Save the MIME part under point."
- (interactive)
+ (interactive (list last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-save-part data))))
-(defun gnus-mime-pipe-part (&optional cmd)
- "Pipe the MIME part under point to a process.
-Use CMD as the process."
- (interactive)
+(defun gnus-mime-pipe-part (&optional cmd event)
+ "Pipe the MIME part under point to a process."
+ (interactive (list nil last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((data (get-text-property (point) 'gnus-data)))
(when data
(mm-pipe-part data cmd))))
-(defun gnus-mime-view-part ()
+(defun gnus-mime-view-part (&optional event)
"Interactively choose a viewing method for the MIME part under point."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (setq gnus-article-mime-handles
- (mm-merge-handles
- gnus-article-mime-handles (setq data (copy-sequence data))))
- (mm-interactively-view-part data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (gnus-article-check-buffer)
+ (let ((data (get-text-property (point) 'gnus-data)))
+ (when data
+ (setq gnus-article-mime-handles
+ (mm-merge-handles
+ gnus-article-mime-handles (setq data (copy-sequence data))))
+ (mm-interactively-view-part data)))))
(defun gnus-mime-view-part-as-type-internal ()
(gnus-article-check-buffer)
@@ -5187,11 +5180,13 @@ Use CMD as the process."
'("text/plain" . 0))
'("application/octet-stream" . 0))))
-(defun gnus-mime-view-part-as-type (&optional mime-type pred)
+(defun gnus-mime-view-part-as-type (&optional mime-type pred event)
"Choose a MIME media type, and view the part as such.
If non-nil, PRED is a predicate to use during completion to limit the
available media-types."
- (interactive)
+ (interactive (list nil nil last-nonmenu-event))
+ (save-excursion
+ (if event (mouse-set-point event))
(unless mime-type
(setq mime-type
(let ((default (gnus-mime-view-part-as-type-internal)))
@@ -5222,13 +5217,14 @@ available media-types."
(mm-merge-handles gnus-article-mime-handles handle))
(when (mm-handle-displayed-p handle)
(mm-remove-part handle))
- (gnus-mm-display-part handle))))
+ (gnus-mm-display-part handle)))))
-(defun gnus-mime-copy-part (&optional handle arg)
+(defun gnus-mime-copy-part (&optional handle arg event)
"Put the MIME part under point into a new buffer.
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
are decompressed."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (mouse-set-point event)
(gnus-article-check-buffer)
(unless handle
(setq handle (get-text-property (point) 'gnus-data)))
@@ -5280,9 +5276,12 @@ are decompressed."
(setq buffer-file-name nil))
(goto-char (point-min)))))
-(defun gnus-mime-print-part (&optional handle filename)
+(defun gnus-mime-print-part (&optional handle filename event)
"Print the MIME part under point."
- (interactive (list nil (ps-print-preprint current-prefix-arg)))
+ (interactive
+ (list nil (ps-print-preprint current-prefix-arg) last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(contents (and handle (mm-get-part handle)))
@@ -5303,12 +5302,13 @@ are decompressed."
(with-temp-buffer
(insert contents)
(gnus-print-buffer))
- (ps-despool filename)))))
+ (ps-despool filename))))))
-(defun gnus-mime-inline-part (&optional handle arg)
+(defun gnus-mime-inline-part (&optional handle arg event)
"Insert the MIME part under point into the current buffer.
Compressed files like .gz and .bz2 are decompressed."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (if event (mouse-set-point event))
(gnus-article-check-buffer)
(let* ((inhibit-read-only t)
(b (point))
@@ -5402,10 +5402,12 @@ CHARSET may either be a string or a symbol."
(setcdr param charset)
(setcdr type (cons (cons 'charset charset) (cdr type)))))))
-(defun gnus-mime-view-part-as-charset (&optional handle arg)
+(defun gnus-mime-view-part-as-charset (&optional handle arg event)
"Insert the MIME part under point into the current buffer using the
specified charset."
- (interactive (list nil current-prefix-arg))
+ (interactive (list nil current-prefix-arg last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let ((handle (or handle (get-text-property (point) 'gnus-data)))
(fun (get-text-property (point) 'gnus-callback))
@@ -5439,11 +5441,13 @@ specified charset."
(setcar (cddr form)
(list 'quote (or (cadr (member preferred parts))
(car parts)))))
- (funcall fun handle)))))
+ (funcall fun handle))))))
-(defun gnus-mime-view-part-externally (&optional handle)
+(defun gnus-mime-view-part-externally (&optional handle event)
"View the MIME part under point with an external viewer."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-inlined-types nil)
@@ -5458,12 +5462,14 @@ specified charset."
(gnus-mime-view-part-as-type
nil (lambda (type) (stringp (mailcap-mime-info type))))
(when handle
- (mm-display-part handle nil t)))))
+ (mm-display-part handle nil t))))))
-(defun gnus-mime-view-part-internally (&optional handle)
+(defun gnus-mime-view-part-internally (&optional handle event)
"View the MIME part under point with an internal viewer.
If no internal viewer is available, use an external viewer."
- (interactive)
+ (interactive (list nil last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
(gnus-article-check-buffer)
(let* ((handle (or handle (get-text-property (point) 'gnus-data)))
(mm-inlined-types '(".*"))
@@ -5477,7 +5483,7 @@ If no internal viewer is available, use an external
viewer."
(gnus-mime-view-part-as-type
nil (lambda (type) (mm-inlinable-p handle type)))
(when handle
- (gnus-bind-mm-vars (mm-display-part handle nil t))))))
+ (gnus-bind-mm-vars (mm-display-part handle nil t)))))))
(defun gnus-mime-action-on-part (&optional action)
"Do something with the MIME attachment at (point)."
@@ -5849,7 +5855,7 @@ all parts."
(widget-convert-button
'link b e
:mime-handle handle
- :action 'gnus-widget-press-button
+ :action #'gnus-widget-press-button
:button-keymap gnus-mime-button-map
:help-echo
(lambda (widget)
@@ -6148,7 +6154,7 @@ If nil, don't show those extra buttons."
article-type multipart
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
+ :action #'gnus-widget-press-button)
;; Do the handles
(while (setq handle (pop handles))
(add-text-properties
@@ -6172,7 +6178,7 @@ If nil, don't show those extra buttons."
gnus-data ,handle
rear-nonsticky t))
(widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button)
+ :action #'gnus-widget-press-button)
(insert " "))
(insert "\n\n"))
(when preferred
@@ -7115,13 +7121,11 @@ If given a prefix, show the hidden text instead."
(when (and do-update-line
(or (numberp article)
(stringp article)))
- (let ((buf (current-buffer)))
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(gnus-summary-update-article do-update-line sparse-header)
(gnus-summary-goto-subject do-update-line nil t)
(set-window-point (gnus-get-buffer-window (current-buffer) t)
- (point))
- (set-buffer buf))))))
+ (point)))))))
(defun gnus-block-private-groups (group)
"Allows images in newsgroups to be shown, blocks images in all
@@ -7316,8 +7320,7 @@ groups."
(gnus-article-mode)
(set-window-configuration winconf)
;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
+ (with-current-buffer curbuf
(set-window-start (get-buffer-window (current-buffer)) window-start)
(goto-char p))))
(gnus-summary-show-article)))
@@ -7869,15 +7872,16 @@ call it with the value of the `gnus-data' text
property."
(when fun
(funcall fun data))))
-(defun gnus-article-press-button ()
+(defun gnus-article-press-button (&optional event)
"Check text at point for a callback function.
If the text at point has a `gnus-callback' property,
call it with the value of the `gnus-data' text property."
- (interactive)
- (let ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
- (when fun
- (funcall fun data))))
+ (interactive (list last-nonmenu-event))
+ (save-excursion
+ (mouse-set-point event)
+ (let ((fun (get-text-property (point) 'gnus-callback)))
+ (when fun
+ (funcall fun (get-text-property (point) 'gnus-data))))))
(defun gnus-article-highlight (&optional force)
"Highlight current article.
@@ -8095,7 +8099,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(list 'mouse-face gnus-article-mouse-face))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
- (widget-convert-button 'link from to :action 'gnus-widget-press-button
+ (widget-convert-button 'link from to :action #'gnus-widget-press-button
:help-echo (or text "Follow the link")
:keymap gnus-url-button-map))
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 485f815..9ae28b1 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -1,4 +1,4 @@
-;;; gnus-cloud.el --- storing and retrieving data via IMAP
+;;; gnus-cloud.el --- storing and retrieving data via IMAP -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2019 Free Software Foundation, Inc.
@@ -52,14 +52,12 @@ Each element may be either a string or a property list.
The latter should have a :directory element whose value is a string,
and a :match element whose value is a regular expression to match
against the basename of files in said directory."
- :group 'gnus-cloud
:type '(repeat (choice (string :tag "File")
(plist :tag "Property list"))))
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
"Storage method for cloud data, defaults to EPG if that's available."
:version "26.1"
- :group 'gnus-cloud
:type '(radio (const :tag "No encoding" nil)
(const :tag "Base64" base64)
(const :tag "Base64+gzip" base64-gzip)
@@ -68,7 +66,6 @@ against the basename of files in said directory."
(defcustom gnus-cloud-interactive t
"Whether Gnus Cloud changes should be confirmed."
:version "26.1"
- :group 'gnus-cloud
:type 'boolean)
(defvar gnus-cloud-group-name "Emacs-Cloud")
@@ -81,7 +78,6 @@ against the basename of files in said directory."
"The IMAP select method used to store the cloud data.
See also `gnus-server-set-cloud-method-server' for an
easy interactive way to set this from the Server buffer."
- :group 'gnus-cloud
:type '(radio (const :tag "Not set" nil)
(string :tag "A Gnus server name as a string")))
@@ -131,8 +127,7 @@ easy interactive way to set this from the Server buffer."
(base64-encode-region (point-min) (point-max)))
((eq gnus-cloud-storage-method 'epg)
- (let ((context (epg-make-context 'OpenPGP))
- cipher)
+ (let ((context (epg-make-context 'OpenPGP)))
(setf (epg-context-armor context) t)
(setf (epg-context-textmode context) t)
(let ((data (epg-encrypt-string context
@@ -353,6 +348,7 @@ Use old data if FORCE-OLDER is not nil."
(group &optional previous method))
(defun gnus-cloud-ensure-cloud-group ()
+ ;; FIXME: `method' is not used!?
(let ((method (if (stringp gnus-cloud-method)
(gnus-server-to-method gnus-cloud-method)
gnus-cloud-method)))
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index e2c728d..4d10e11 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -644,7 +644,14 @@ articles in the topic and its subtopics."
(add-text-properties
(point)
(prog1 (1+ (point))
- (eval gnus-topic-line-format-spec))
+ (eval gnus-topic-line-format-spec
+ `((indentation . ,indentation)
+ (visible . ,visible)
+ (name . ,name)
+ (level . ,level)
+ (number-of-groups . ,number-of-groups)
+ (total-number-of-articles . ,total-number-of-articles)
+ (entries . ,entries))))
(list 'gnus-topic name
'gnus-topic-level level
'gnus-topic-unread unread
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 31421cc..fcd5ec6 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -38,7 +38,7 @@
(require 'time-date)
(require 'text-property-search)
-(defcustom gnus-completing-read-function 'gnus-emacs-completing-read
+(defcustom gnus-completing-read-function #'gnus-emacs-completing-read
"Function use to do completing read."
:version "24.1"
:group 'gnus-meta
@@ -87,6 +87,7 @@ This is a compatibility function for different Emacsen."
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
+ (declare (indent 1) (debug (form body)))
(let ((tempvar (make-symbol "GnusStartBufferWindow"))
(w (make-symbol "w"))
(buf (make-symbol "buf")))
@@ -103,9 +104,6 @@ This is a compatibility function for different Emacsen."
,@forms)
(select-window ,tempvar)))))
-(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
-(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
-
(defsubst gnus-goto-char (point)
(and point (goto-char point)))
@@ -302,26 +300,24 @@ Symbols are also allowed; their print names are used
instead."
(defmacro gnus-local-set-keys (&rest plist)
"Set the keys in PLIST in the current keymap."
+ (declare (indent 1))
`(gnus-define-keys-1 (current-local-map) ',plist))
(defmacro gnus-define-keys (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
+ (declare (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
(defmacro gnus-define-keys-safe (keymap &rest plist)
"Define all keys in PLIST in KEYMAP without overwriting previous
definitions."
+ (declare (indent 1))
`(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys-safe 'lisp-indent-function 1)
-(put 'gnus-local-set-keys 'lisp-indent-function 1)
-
(defmacro gnus-define-keymap (keymap &rest plist)
"Define all keys in PLIST in KEYMAP."
+ (declare (indent 1))
`(gnus-define-keys-1 ,keymap (quote ,plist)))
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-
(defun gnus-define-keys-1 (keymap plist &optional safe)
(when (null keymap)
(error "Can't set keys in a null keymap"))
@@ -444,7 +440,7 @@ displayed in the echo area."
`(let (str time)
(cond ((eq gnus-add-timestamp-to-message 'log)
(setq str (let (message-log-max)
- (apply 'message ,format-string ,args)))
+ (apply #'message ,format-string ,args)))
(when (and message-log-max
(> message-log-max 0)
(/= (length str) 0))
@@ -462,7 +458,7 @@ displayed in the echo area."
(gnus-add-timestamp-to-message
(if (or (and (null ,format-string) (null ,args))
(progn
- (setq str (apply 'format ,format-string ,args))
+ (setq str (apply #'format ,format-string ,args))
(zerop (length str))))
(prog1
(and ,format-string str)
@@ -471,7 +467,7 @@ displayed in the echo area."
(message "%s" (concat ,timestamp str))
str))
(t
- (apply 'message ,format-string ,args)))))))
+ (apply #'message ,format-string ,args)))))))
(defvar gnus-action-message-log nil)
@@ -490,9 +486,10 @@ that take a long time, 7 - not very important messages on
stuff, 9 - messages
inside loops."
(if (<= level gnus-verbose)
(let ((message
- (if gnus-add-timestamp-to-message
- (apply 'gnus-message-with-timestamp args)
- (apply 'message args))))
+ (apply (if gnus-add-timestamp-to-message
+ #'gnus-message-with-timestamp
+ #'message)
+ args)))
(when (and (consp gnus-action-message-log)
(<= level 3))
(push message gnus-action-message-log))
@@ -500,7 +497,7 @@ inside loops."
;; We have to do this format thingy here even if the result isn't
;; shown - the return value has to be the same as the return value
;; from `message'.
- (apply 'format args)))
+ (apply #'format args)))
(defun gnus-final-warning ()
(when (and (consp gnus-action-message-log)
@@ -513,7 +510,7 @@ inside loops."
"Beep an error if LEVEL is equal to or less than `gnus-verbose'.
ARGS are passed to `message'."
(when (<= (floor level) gnus-verbose)
- (apply 'message args)
+ (apply #'message args)
(ding)
(let (duration)
(when (and (floatp level)
@@ -688,18 +685,20 @@ Lisp objects are loadable. Bind `print-quoted' and
`print-readably'
to t, and `print-escape-multibyte', `print-escape-newlines',
`print-escape-nonascii', `print-length', `print-level' and
`print-string-length' to nil."
- `(let ((print-quoted t)
- (print-readably t)
- ;;print-circle
- ;;print-continuous-numbering
- print-escape-multibyte
- print-escape-newlines
- print-escape-nonascii
- ;;print-gensym
- print-length
- print-level
- print-string-length)
- ,@forms))
+ `(progn
+ (defvar print-string-length) (defvar print-readably)
+ (let ((print-quoted t)
+ (print-readably t)
+ ;;print-circle
+ ;;print-continuous-numbering
+ print-escape-multibyte
+ print-escape-newlines
+ print-escape-nonascii
+ ;;print-gensym
+ print-length
+ print-level
+ print-string-length)
+ ,@forms)))
(defun gnus-prin1 (form)
"Use `prin1' on FORM in the current buffer.
@@ -852,11 +851,10 @@ the user are disabled, it is recommended that only the
most minimal
operations are performed by FORMS. If you wish to assign many
complicated values atomically, compute the results into temporary
variables and then do only the assignment atomically."
+ (declare (indent 0))
`(let ((inhibit-quit gnus-atomic-be-safe))
,@forms))
-(put 'gnus-atomic-progn 'lisp-indent-function 0)
-
(defmacro gnus-atomic-progn-assign (protect &rest forms)
"Evaluate FORMS, but ensure that the variables listed in PROTECT
are not changed if anything in FORMS signals an error or otherwise
@@ -866,6 +864,7 @@ It is safe to use gnus-atomic-progn-assign with long
computations.
Note that if any of the symbols in PROTECT were unbound, they will be
set to nil on a successful assignment. In case of an error or other
non-local exit, it will still be unbound."
+ (declare (indent 1)) ;;(debug (sexp body))
(let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
(concat (symbol-name x)
"-tmp"))
@@ -878,8 +877,8 @@ non-local exit, it will still be unbound."
,(cadr x))))
temp-sym-map))
(sym-temp-let sym-temp-map)
- (temp-sym-assign (apply 'append temp-sym-map))
- (sym-temp-assign (apply 'append sym-temp-map))
+ (temp-sym-assign (apply #'append temp-sym-map))
+ (sym-temp-assign (apply #'append sym-temp-map))
(result (make-symbol "result-tmp")))
`(let (,@temp-sym-let
,result)
@@ -890,9 +889,6 @@ non-local exit, it will still be unbound."
(setq ,@sym-temp-assign))
,result)))
-(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
-;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
-
(defmacro gnus-atomic-setq (&rest pairs)
"Similar to setq, except that the real symbols are only assigned when
there are no errors. And when the real symbols are assigned, they are
@@ -1102,16 +1098,16 @@ ARG is passed to the first function."
(defun gnus-run-hooks (&rest funcs)
"Does the same as `run-hooks', but saves the current buffer."
(save-current-buffer
- (apply 'run-hooks funcs)))
+ (apply #'run-hooks funcs)))
(defun gnus-run-hook-with-args (hook &rest args)
"Does the same as `run-hook-with-args', but saves the current buffer."
(save-current-buffer
- (apply 'run-hook-with-args hook args)))
+ (apply #'run-hook-with-args hook args)))
(defun gnus-run-mode-hooks (&rest funcs)
"Run `run-mode-hooks', saving the current buffer."
- (save-current-buffer (apply 'run-mode-hooks funcs)))
+ (save-current-buffer (apply #'run-mode-hooks funcs)))
;;; Various
@@ -1194,6 +1190,7 @@ ARG is passed to the first function."
;; Fixme: Why not use `with-output-to-temp-buffer'?
(defmacro gnus-with-output-to-file (file &rest body)
+ (declare (indent 1) (debug (form body)))
(let ((buffer (make-symbol "output-buffer"))
(size (make-symbol "output-buffer-size"))
(leng (make-symbol "output-buffer-length"))
@@ -1216,9 +1213,6 @@ ARG is passed to the first function."
(write-region (substring ,buffer 0 ,leng) nil ,file
,append 'no-msg))))))
-(put 'gnus-with-output-to-file 'lisp-indent-function 1)
-(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
-
(defun gnus-add-text-properties-when
(property value start end properties &optional object)
"Like `add-text-properties', only applied on where PROPERTY is VALUE."
@@ -1306,7 +1300,7 @@ sure of changing the value of `foo'."
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
-(defun gnus-not-ignore (&rest args)
+(defun gnus-not-ignore (&rest _)
t)
(defvar gnus-directory-sep-char-regexp "/"
@@ -1358,7 +1352,7 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
`(,spec elem))
((listp spec)
(if (memq (car spec) '(or and not))
- `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
+ `(,(car spec) ,@(mapcar #'gnus-make-predicate-1 (cdr spec)))
(error "Invalid predicate specifier: %s" spec)))))
(defun gnus-completing-read (prompt collection &optional require-match
@@ -1397,6 +1391,8 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
;; Make sure iswitchb is loaded before we let-bind its variables.
;; If it is loaded inside the let, variables can become unbound afterwards.
(require 'iswitchb)
+ (declare-function iswitchb-minibuffer-setup "iswitchb" ())
+ (defvar iswitchb-make-buflist-hook)
(let ((iswitchb-make-buflist-hook
(lambda ()
(setq iswitchb-temp-buflist
@@ -1410,16 +1406,14 @@ SPEC is a predicate specifier that contains stuff like
`or', `and',
(unwind-protect
(progn
(or iswitchb-mode
- (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))
+ (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))
(iswitchb-read-buffer prompt def require-match))
(or iswitchb-mode
- (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup)))))
-
-(put 'gnus-parse-without-error 'lisp-indent-function 0)
-(put 'gnus-parse-without-error 'edebug-form-spec '(body))
+ (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup)))))
(defmacro gnus-parse-without-error (&rest body)
"Allow continuing onto the next line even if an error occurs."
+ (declare (indent 0) (debug (body)))
`(while (not (eobp))
(condition-case ()
(progn
@@ -1510,18 +1504,17 @@ Return nil otherwise."
(defvar tool-bar-mode)
-(defun gnus-tool-bar-update (&rest ignore)
+(defun gnus-tool-bar-update (&rest _)
"Update the tool bar."
- (when (and (boundp 'tool-bar-mode)
- tool-bar-mode)
+ (when (bound-and-true-p tool-bar-mode)
(let* ((args nil)
(func (cond ((fboundp 'tool-bar-update)
- 'tool-bar-update)
+ #'tool-bar-update)
((fboundp 'force-window-update)
- 'force-window-update)
+ #'force-window-update)
((fboundp 'redraw-frame)
(setq args (list (selected-frame)))
- 'redraw-frame)
+ #'redraw-frame)
(t 'ignore))))
(apply func args))))
@@ -1536,7 +1529,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
(if seqs2_n
(let* ((seqs (cons seq1 seqs2_n))
(cnt 0)
- (heads (mapcar (lambda (seq)
+ (heads (mapcar (lambda (_seq)
(make-symbol (concat "head"
(int-to-string
(setq cnt (1+ cnt))))))
@@ -1569,8 +1562,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
system-configuration)
((memq 'type lst)
(symbol-name system-type))
- (t nil)))
- codename)
+ (t nil))))
(cond
((not (memq 'emacs lst))
nil)
@@ -1586,9 +1578,7 @@ sequence, this is like `mapcar'. With several, it is
like the Common Lisp
empty directories from OLD-PATH."
(when (file-exists-p old-path)
(let* ((old-dir (file-name-directory old-path))
- (old-name (file-name-nondirectory old-path))
(new-dir (file-name-directory new-path))
- (new-name (file-name-nondirectory new-path))
temp)
(gnus-make-directory new-dir)
(rename-file old-path new-path t)
@@ -1693,7 +1683,7 @@ lists of strings."
(setq props (plist-put props :foreground (face-foreground face)))
(setq props (plist-put props :background (face-background face))))
(ignore-errors
- (apply 'create-image file type data-p props))))
+ (apply #'create-image file type data-p props))))
(defun gnus-put-image (glyph &optional string category)
(let ((point (point)))
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 9e52abc..760bcc2 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,4 +1,4 @@
-;;; nnimap.el --- IMAP interface for Gnus
+;;; nnimap.el --- IMAP interface for Gnus -*- lexical-binding:t -*-
;; Copyright (C) 2010-2019 Free Software Foundation, Inc.
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index f036a5a..949def1 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -591,7 +591,7 @@ FILE is the file where FUNCTION was probably defined."
;; of the *packages* in which the function is defined.
(let* ((name (symbol-name symbol))
(re (concat "\\_<" (regexp-quote name) "\\_>"))
- (news (directory-files data-directory t "\\`NEWS.[1-9]"))
+ (news (directory-files data-directory t "\\`NEWS"))
(place nil)
(first nil))
(with-temp-buffer
@@ -606,7 +606,7 @@ FILE is the file where FUNCTION was probably defined."
;; Almost all entries are of the form "* ... in Emacs NN.MM."
;; but there are also a few in the form "* Emacs NN.MM is a bug
;; fix release ...".
- (if (not (re-search-backward "^\\*.* Emacs \\([0-9.]+[0-9]\\)"
+ (if (not (re-search-backward "^\\* .* Emacs \\([0-9.]+[0-9]\\)"
nil t))
(message "Ref found in non-versioned section in %S"
(file-name-nondirectory f))
@@ -615,8 +615,7 @@ FILE is the file where FUNCTION was probably defined."
(setq place (list f pos))
(setq first version)))))))))
(when first
- (make-text-button first nil 'type 'help-news 'help-args place))
- first))
+ (make-text-button first nil 'type 'help-news 'help-args place))))
(add-hook 'help-fns-describe-function-functions
#'help-fns--mention-first-release)
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f42b594..201efb7 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1537,7 +1537,7 @@ Return the input string."
(quail-terminate-translation))
(defun quail-update-translation (control-flag)
-"Update the current translation status according to CONTROL-FLAG.
+ "Update the current translation status according to CONTROL-FLAG.
If CONTROL-FLAG is integer value, it is the number of keys in the
head `quail-current-key' which can be translated. The remaining keys
are 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 9f603c0..3f28144 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."
(let ((folder mh-current-folder)
(window-config mh-previous-window-config))
(mh-set-folder-modified-p t) ; lock folder to kill it
- (mh-exec-cmd-daemon "rmf" 'mh-rmf-daemon folder)
+ (mh-exec-cmd-daemon "rmf" #'mh-rmf-daemon folder)
(when (boundp 'mh-speed-folder-map)
(mh-speed-invalidate-map folder))
(mh-remove-from-sub-folders-cache folder)
@@ -123,7 +123,7 @@ folder. This is useful for folders that are easily
regenerated."
(message "Folder %s removed" folder))
(message "Folder not removed")))
-(defun mh-rmf-daemon (process output)
+(defun mh-rmf-daemon (_process output)
"The rmf PROCESS puts OUTPUT in temporary buffer.
Display the results only if something went wrong."
(set-buffer (get-buffer-create mh-temp-buffer))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 5770276..0ec2b68 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1225,6 +1225,45 @@ scroll the window of possible completions."
(if (eq (car bounds) base) md-at-point
(completion-metadata (substring string 0 base) table pred))))
+(defun completion-score-sort (completions)
+ (sort completions
+ (lambda (x y)
+ (> (or (get-text-property 0 'completion-score x) 0)
+ (or (get-text-property 0 'completion-score y) 0)))))
+
+(defun completion-sort (all &optional prefer-regular table-sort-fun)
+ "Sort ALL, which is the list of all the completion strings we found.
+If PREFER-REGULAR, then give a bit more importance to returning
+an ordering that is easy to scan quickly (e.g. lexicographic) rather
+then trying to minimize the expected position of the completion
+actually desired.
+TABLE-SORT-FUN is the sorting function specified by the completion table,
+if applicable.
+The sort is performed in a destructive way."
+ (cond
+ (table-sort-fun
+ ;; I feel like we should slowly deprecate table-sort-fun (probably
+ ;; replacing it with a way for the completion table to provide scores),
+ ;; so let's not try to be clever here.
+ (funcall table-sort-fun all))
+ (t
+ ;; Prefer shorter completions, by default.
+ (if prefer-regular
+ (setq all (sort all #'string-lessp))
+ (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
+ (if (minibufferp)
+ ;; Prefer recently used completions and put the default, if
+ ;; it exists, on top.
+ (let ((hist (symbol-value minibuffer-history-variable)))
+ (setq all (sort all
+ (lambda (c1 c2)
+ (cond ((equal c1 minibuffer-default) t)
+ ((equal c2 minibuffer-default) nil)
+ (t (> (length (member c1 hist))
+ (length (member c2 hist)))))))))))
+ (setq all (completion-score-sort all))
+ all)))
+
(defun completion-all-sorted-completions (&optional start end)
(or completion-all-sorted-completions
(let* ((start (or start (minibuffer-prompt-end)))
@@ -1254,23 +1293,7 @@ scroll the window of possible completions."
(setq all (delete-dups all))
(setq last (last all))
- (cond
- (sort-fun
- (setq all (funcall sort-fun all)))
- (t
- ;; Prefer shorter completions, by default.
- (setq all (sort all (lambda (c1 c2) (< (length c1) (length c2)))))
- (if (minibufferp)
- ;; Prefer recently used completions and put the default, if
- ;; it exists, on top.
- (let ((hist (symbol-value minibuffer-history-variable)))
- (setq all
- (sort all
- (lambda (c1 c2)
- (cond ((equal c1 minibuffer-default) t)
- ((equal c2 minibuffer-default) nil)
- (t (> (length (member c1 hist))
- (length (member c2 hist))))))))))))
+ (setq all (completion-sort all nil sort-fun))
;; Cache the result. This is not just for speed, but also so that
;; repeated calls to minibuffer-force-complete can cycle through
;; all possibilities.
@@ -1887,9 +1910,7 @@ variables.")
;; not always.
(let ((sort-fun (completion-metadata-get
all-md 'display-sort-function)))
- (if sort-fun
- (funcall sort-fun completions)
- (sort completions 'string-lessp))))
+ (completion-sort completions 'prefer-regular sort-fun)))
(when afun
(setq completions
(mapcar (lambda (s)
@@ -2870,7 +2891,9 @@ Return the new suffix."
'point
(substring afterpoint 0 (cdr bounds)))))
(all (completion-pcm--all-completions prefix pattern table pred)))
- (completion-hilit-commonality all point (car bounds))))
+ (when all
+ (nconc (completion-pcm--hilit-commonality pattern all)
+ (car bounds)))))
;;; Partial-completion-mode style completion.
@@ -3033,8 +3056,8 @@ PATTERN is as returned by
`completion-pcm--string->pattern'."
(when (string-match-p regex c) (push c poss)))
(nreverse poss))))))
-(defvar flex-score-match-tightness 100
- "Controls how the `flex' completion style scores its matches.
+(defvar completion-score-match-tightness 100
+ "Controls how the completion style scores its matches.
Value is a positive number. Values smaller than one make the
scoring formula value matches scattered along the string, while
@@ -3079,7 +3102,7 @@ latter (which has two).")
;; For the numerator, we use the number of +, i.e. the
;; length of the pattern. For the denominator, it
;; sums (1+ (/ (grouplen - 1)
- ;; flex-score-match-tightness)) across all groups of
+ ;; completion-score-match-tightness)) across all groups of
;; -, sums one to that total, and then multiples by
;; the length of the string.
(score-numerator 0)
@@ -3095,7 +3118,7 @@ latter (which has two).")
score-denominator (+ score-denominator
1
(/ (- a last-b 1)
- flex-score-match-tightness
+ completion-score-match-tightness
1.0))))
(setq
last-b b))))
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 75fc7d6..7beb61b 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,4 +1,4 @@
-;;; ldap.el --- client interface to LDAP for Emacs
+;;; ldap.el --- client interface to LDAP for Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
@@ -419,12 +419,12 @@ RFC2798 Section 9.1.1")
(encode-coding-string str ldap-coding-system))
(defun ldap-decode-address (str)
- (mapconcat 'ldap-decode-string
+ (mapconcat #'ldap-decode-string
(split-string str "\\$")
"\n"))
(defun ldap-encode-address (str)
- (mapconcat 'ldap-encode-string
+ (mapconcat #'ldap-encode-string
(split-string str "\n")
"$"))
@@ -566,9 +566,9 @@ its distinguished name DN.
The function returns a list of matching entries. Each entry is itself
an alist of attribute/value pairs."
(let* ((buf (get-buffer-create " *ldap-search*"))
- (bufval (get-buffer-create " *ldap-value*"))
- (host (or (plist-get search-plist 'host)
- ldap-default-host))
+ (bufval (get-buffer-create " *ldap-value*"))
+ (host (or (plist-get search-plist 'host)
+ ldap-default-host))
;; find entries with port "ldap" that match the requested host if any
(asfound (when (plist-get search-plist 'auth-source)
(nth 0 (auth-source-search :host (or host t)
@@ -592,59 +592,60 @@ an alist of attribute/value pairs."
(base (or (plist-get search-plist 'base)
(plist-get asfound :base)
ldap-default-base))
- (filter (plist-get search-plist 'filter))
- (attributes (plist-get search-plist 'attributes))
- (attrsonly (plist-get search-plist 'attrsonly))
- (scope (plist-get search-plist 'scope))
- (auth (plist-get search-plist 'auth))
- (deref (plist-get search-plist 'deref))
- (timelimit (plist-get search-plist 'timelimit))
- (sizelimit (plist-get search-plist 'sizelimit))
- (withdn (plist-get search-plist 'withdn))
- (numres 0)
- arglist dn name value record result proc)
+ (filter (plist-get search-plist 'filter))
+ (attributes (plist-get search-plist 'attributes))
+ (attrsonly (plist-get search-plist 'attrsonly))
+ (scope (plist-get search-plist 'scope))
+ (auth (plist-get search-plist 'auth))
+ (deref (plist-get search-plist 'deref))
+ (timelimit (plist-get search-plist 'timelimit))
+ (sizelimit (plist-get search-plist 'sizelimit))
+ (withdn (plist-get search-plist 'withdn))
+ (numres 0)
+ (arglist
+ (append
+ (if (and host
+ (not (equal "" host)))
+ (list (format
+ ;; Use -H if host is a new-style LDAP URI.
+ (if (string-match "\\`[a-zA-Z]+://" host)
+ "-H%s"
+ "-h%s")
+ host)))
+ (if (and attrsonly
+ (not (equal "" attrsonly)))
+ (list "-A"))
+ (if (and base
+ (not (equal "" base)))
+ (list (format "-b%s" base)))
+ (if (and scope
+ (not (equal "" scope)))
+ (list (format "-s%s" scope)))
+ (if (and binddn
+ (not (equal "" binddn)))
+ (list (format "-D%s" binddn)))
+ (if (and auth
+ (equal 'simple auth))
+ (list "-x"))
+ ;; Allow passwd to be set to "", representing a blank password.
+ (if passwd
+ (list "-W"))
+ (if (and deref
+ (not (equal "" deref)))
+ (list (format "-a%s" deref)))
+ (if (and timelimit
+ (not (equal "" timelimit)))
+ (list (format "-l%s" timelimit)))
+ (if (and sizelimit
+ (not (equal "" sizelimit)))
+ (list (format "-z%s" sizelimit)))))
+ dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
(setq filter (cons filter attributes))
(with-current-buffer buf
(erase-buffer)
- (if (and host
- (not (equal "" host)))
- (setq arglist (nconc arglist
- (list (format
- ;; Use -H if host is a new-style LDAP URI.
- (if (string-match "^[a-zA-Z]+://" host)
- "-H%s"
- "-h%s")
- host)))))
- (if (and attrsonly
- (not (equal "" attrsonly)))
- (setq arglist (nconc arglist (list "-A"))))
- (if (and base
- (not (equal "" base)))
- (setq arglist (nconc arglist (list (format "-b%s" base)))))
- (if (and scope
- (not (equal "" scope)))
- (setq arglist (nconc arglist (list (format "-s%s" scope)))))
- (if (and binddn
- (not (equal "" binddn)))
- (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
- (if (and auth
- (equal 'simple auth))
- (setq arglist (nconc arglist (list "-x"))))
- ;; Allow passwd to be set to "", representing a blank password.
- (if passwd
- (setq arglist (nconc arglist (list "-W"))))
- (if (and deref
- (not (equal "" deref)))
- (setq arglist (nconc arglist (list (format "-a%s" deref)))))
- (if (and timelimit
- (not (equal "" timelimit)))
- (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
- (if (and sizelimit
- (not (equal "" sizelimit)))
- (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
(if passwd
;; Leave process-connection-type at its default value. See
;; discussion in Bug#33050.
@@ -672,7 +673,7 @@ an alist of attribute/value pairs."
" bind distinguished name (binddn)"))
(error "Failed ldapsearch invocation: %s \"%s\""
ldap-ldapsearch-prog
- (mapconcat 'identity proc-args "\" \""))))))
+ (mapconcat #'identity proc-args "\" \""))))))
(apply #'call-process ldap-ldapsearch-prog
;; Ignore stderr, which can corrupt results
nil (list buf nil) nil
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 24084c8..96a7b12 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1871,11 +1871,11 @@ This function does not alter the INPUT string."
(setq global-mode-string
(append global-mode-string '(rcirc-activity-string))))
(add-hook 'window-configuration-change-hook
- 'rcirc-window-configuration-change))
+ #'rcirc-window-configuration-change))
(setq global-mode-string
(delete 'rcirc-activity-string global-mode-string))
(remove-hook 'window-configuration-change-hook
- 'rcirc-window-configuration-change)))
+ #'rcirc-window-configuration-change)))
(or (assq 'rcirc-ignore-buffer-activity-flag minor-mode-alist)
(setq minor-mode-alist
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index ac706b9..f4ca6e7 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -334,6 +334,92 @@ terminated by the end of line (i.e., `comment-end' is
empty)."
(const :tag "EOL-terminated" eol))
:group 'comment)
+;;;; Setup syntax from "high-level" description of comment syntax
+
+;; This defines `comment-set-syntax' so a major mode can just call
+;; this one function to setup the comment syntax both in the syntax-table
+;; and in the various comment-* variables.
+
+(defvar comment--set-table
+ ;; We want to associate extra properties with syntax-table, but syntax-tables
+ ;; don't have "properties", so we use an eq-hash-table indexed by
+ ;; syntax-tables instead.
+ (make-hash-table :test #'eq))
+
+(defun comment--set-comment-syntax (st comment-list)
+ "Set up comment functionality for generic mode."
+ (let ((chars nil)
+ (comstyles)
+ (comment-start nil))
+
+ ;; Go through all the comments.
+ (pcase-dolist (`(,start ,end . ,props) comment-list)
+ (let ((nested (if (plist-get props :nested) "n"))
+ (comstyle
+ ;; Reuse comstyles if necessary.
+ (or (cdr (assoc start comstyles))
+ (cdr (assoc end comstyles))
+ ;; Otherwise, use a style not yet in use.
+ (if (not (rassoc "" comstyles)) "")
+ (if (not (rassoc "b" comstyles)) "b")
+ "c")))
+ (push (cons start comstyle) comstyles)
+ (push (cons end comstyle) comstyles)
+
+ ;; Setup the syntax table.
+ (if (= (length start) 1)
+ (modify-syntax-entry (aref start 0)
+ (concat "< " comstyle nested) st)
+ (let ((c0 (aref start 0)) (c1 (aref start 1)))
+ ;; Store the relevant info but don't update yet.
+ (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
+ (push (cons c1 (concat (cdr (assoc c1 chars))
+ (concat "2" comstyle)))
+ chars)))
+ (if (= (length end) 1)
+ (modify-syntax-entry (aref end 0)
+ (concat "> " comstyle nested) st)
+ (let ((c0 (aref end 0)) (c1 (aref end 1)))
+ ;; Store the relevant info but don't update yet.
+ (push (cons c0 (concat (cdr (assoc c0 chars))
+ (concat "3" comstyle)))
+ chars)
+ (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
+
+ ;; Process the chars that were part of a 2-char comment marker
+ (with-syntax-table st ;For `char-syntax'.
+ (dolist (cs (nreverse chars))
+ (modify-syntax-entry (car cs)
+ (concat (char-to-string (char-syntax (car cs)))
+ " " (cdr cs))
+ st)))))
+
+(defun comment--set-comment-vars (comment-list)
+ (when comment-list
+ (let ((first (car comment-list)))
+ (setq-local comment-start (car first))
+ (setq-local comment-end
+ (let ((end (cadr first)))
+ (if (string-equal end "\n") "" end))))
+ (unless comment-start-skip ;Don't override manual setup.
+ (setq-local comment-start-skip
+ (concat (regexp-opt (mapcar #'car comment-list))
+ "+[ \t]*")))
+ (unless comment-end-skip ;Don't override manual setup.
+ (setq-local comment-end-skip
+ (concat "[ \t]*"
+ (regexp-opt (mapcar #'cadr comment-list)))))))
+
+(defun comment-set-syntax (st comment-list)
+ (comment--set-comment-syntax st comment-list)
+ (setf (gethash st comment--set-table) comment-list))
+
+(defun comment-get-syntax (&optional st)
+ (unless st (setq st (syntax-table)))
+ (or (gethash st comment--set-table)
+ (let ((parent (char-table-parent st)))
+ (when parent (comment-get-syntax parent)))))
+
;;;;
;;;; Helpers
;;;;
@@ -358,11 +444,14 @@ functions work correctly. Lisp callers of any other
`comment-*'
function should first call this function explicitly."
(unless (and (not comment-start) noerror)
(unless comment-start
- (let ((cs (read-string "No comment syntax is defined. Use: ")))
- (if (zerop (length cs))
- (error "No comment syntax defined")
- (set (make-local-variable 'comment-start) cs)
- (set (make-local-variable 'comment-start-skip) cs))))
+ (let ((comment-list (comment-get-syntax)))
+ (if comment-list
+ (comment--set-comment-vars comment-list)
+ (let ((cs (read-string "No comment syntax is defined. Use: ")))
+ (if (zerop (length cs))
+ (error "No comment syntax defined")
+ (set (make-local-variable 'comment-start) cs)
+ (set (make-local-variable 'comment-start-skip) cs))))))
;; comment-use-syntax
(when (eq comment-use-syntax 'undecided)
(set (make-local-variable 'comment-use-syntax)
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 798475b..e2bb8ad 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -83,10 +83,11 @@ Signal an error if URI is not a valid file URL."
(cond ((not scheme)
(unless pattern
(rng-uri-error "URI `%s' does not have a scheme" uri)))
- ((not (string= (downcase scheme) "file"))
- (rng-uri-error "URI `%s' does not use the `file:' scheme" uri)))
- (when (not (member authority
- (cons (system-name) '(nil "" "localhost"))))
+ ((not (member (downcase scheme) '("file" "http")))
+ (rng-uri-error "URI `%s' does not use the `file:' or `http:' scheme"
uri)))
+ (when (and (equal (downcase scheme) "file")
+ (not (member authority
+ (cons (system-name) '(nil "" "localhost")))))
(rng-uri-error "URI `%s' does not start with `file:///' or
`file://localhost/'"
uri))
(when query
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index afa33e0..c0bf29a 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -439,7 +439,8 @@ and VALUE-END, otherwise a STRING giving the value."
(comment
(xmltok+ (xmltok-g markup-declaration "!")
(xmltok-g comment-first-dash "-"
- (xmltok-g comment-open "-") opt) opt))
+ (xmltok-g comment-open "-") opt)
+ opt))
(cdata-section
(xmltok+ "!"
(xmltok-g marked-section-open "\\[")
@@ -540,7 +541,9 @@ and VALUE-END, otherwise a STRING giving the value."
"%" (xmltok-g param-entity-ref
ncname
(xmltok-g param-entity-ref-close
- ";") opt) opt))
+ ";")
+ opt)
+ opt))
(starts-with-nmtoken-not-name
(xmltok-g nmtoken
(xmltok-p name-continue-not-start-char or ":")
@@ -571,7 +574,8 @@ and VALUE-END, otherwise a STRING giving the value."
"!" (xmltok-p (xmltok-g comment-first-dash "-"
(xmltok-g comment-open "-") opt)
or (xmltok-g named-markup-declaration
- ncname)) opt))
+ ncname))
+ opt))
(after-lt
(xmltok+ markup-declaration
or (xmltok-g processing-instruction-question
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 5aa49b2..6f83d5a 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -7430,7 +7430,6 @@ a block. Return a non-nil value when toggling is
successful."
(org-defkey map [(right)] 'org-goto-right)
(org-defkey map [(control ?g)] 'org-goto-quit)
(org-defkey map "\C-i" 'org-cycle)
- (org-defkey map [(tab)] 'org-cycle)
(org-defkey map [(down)] 'outline-next-visible-heading)
(org-defkey map [(up)] 'outline-previous-visible-heading)
(if org-goto-auto-isearch
@@ -12999,8 +12998,7 @@ Returns the new TODO keyword, or nil if no state change
should occur."
(and (= c ?q) (not (rassoc c fulltable))))
(setq quit-flag t))
((= c ?\ ) nil)
- ((setq e (rassoc c fulltable) tg (car e))
- tg)
+ ((car (rassoc c fulltable)))
(t (setq quit-flag t)))))))
(defun org-entry-is-todo-p ()
@@ -15213,11 +15211,11 @@ Returns the new tags string, or nil to not change the
current settings."
(setq current (delete tg current))
(push tg current)))
(when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c todo-table) tg (car e))
+ ((setq tg (car (rassoc c todo-table)))
(with-current-buffer buf
(save-excursion (org-todo tg)))
(when exit-after-next (setq exit-after-next 'now)))
- ((setq e (rassoc c ntable) tg (car e))
+ ((setq tg (car (rassoc c ntable)))
(if (member tg current)
(setq current (delete tg current))
(cl-loop for g in groups do
@@ -17616,27 +17614,28 @@ D may be an absolute day number, or a calendar-type
list (month day year)."
(defun org-diary-sexp-entry (sexp entry d)
"Process a SEXP diary ENTRY for date D."
+ ;; FIXME: Consolidate with diary-sexp-entry!
(require 'diary-lib)
;; `org-anniversary' and alike expect ENTRY and DATE to be bound
;; dynamically.
- (let* ((sexp `(let ((entry ,entry)
- (date ',d))
- ,(car (read-from-string sexp))))
+ (let* ((user-sexp (car (read-from-string sexp)))
+ (sexp `(let ((entry ,entry) (date ',d)) ,user-sexp))
(result (if calendar-debug-sexp (eval sexp)
- (condition-case nil
+ (condition-case err
(eval sexp)
(error
(beep)
- (message "Bad sexp at line %d in %s: %s"
+ (message "Bad sexp at line %d in %s: %S\nError: %S"
(org-current-line)
- (buffer-file-name) sexp)
+ (buffer-file-name) user-sexp err)
(sleep-for 2))))))
(cond ((stringp result) (split-string result "; "))
((and (consp result)
(not (consp (cdr result)))
- (stringp (cdr result))) (cdr result))
- ((and (consp result)
- (stringp (car result))) result)
+ (stringp (cdr result)))
+ (cdr result))
+ ((and (consp result) (stringp (car result)))
+ result)
(result entry))))
(defun org-diary-to-ical-string (frombuf)
@@ -23287,7 +23286,7 @@ major mode."
(if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
(open-line 1))
(org-indent-line)
- (insert "# ")))
+ (insert comment-start)))
(defvar comment-empty-lines) ; From newcomment.el.
(defun org-comment-or-uncomment-region (beg end &rest _)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 401e5aa..73fd970 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -30,7 +30,7 @@
;; To use pcomplete with shell-mode, for example, you will need the
;; following in your init file:
;;
-;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
+;; (add-hook 'shell-mode-hook #'pcomplete-shell-setup)
;;
;; Most of the code below simply provides support mechanisms for
;; writing completion functions. Completion functions themselves are
@@ -129,31 +129,26 @@
(defcustom pcomplete-file-ignore nil
"A regexp of filenames to be disregarded during file completion."
- :type '(choice regexp (const :tag "None" nil))
- :group 'pcomplete)
+ :type '(choice regexp (const :tag "None" nil)))
(defcustom pcomplete-dir-ignore nil
"A regexp of names to be disregarded during directory completion."
- :type '(choice regexp (const :tag "None" nil))
- :group 'pcomplete)
+ :type '(choice regexp (const :tag "None" nil)))
(defcustom pcomplete-ignore-case (memq system-type '(ms-dos windows-nt cygwin))
;; FIXME: the doc mentions file-name completion, but the code
;; seems to apply it to all completions.
"If non-nil, ignore case when doing filename completion."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(defcustom pcomplete-autolist nil
"If non-nil, automatically list possibilities on partial completion.
This mirrors the optional behavior of tcsh."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(defcustom pcomplete-suffix-list (list ?/ ?:)
"A list of characters which constitute a proper suffix."
- :type '(repeat character)
- :group 'pcomplete)
+ :type '(repeat character))
(make-obsolete-variable 'pcomplete-suffix-list nil "24.1")
(defcustom pcomplete-recexact nil
@@ -161,25 +156,22 @@ This mirrors the optional behavior of tcsh."
This mirrors the optional behavior of tcsh.
A non-nil value is useful if `pcomplete-autolist' is non-nil too."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(define-obsolete-variable-alias
'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3")
-(defcustom pcomplete-man-function 'man
+(defcustom pcomplete-man-function #'man
"A function to that will be called to display a manual page.
It will be passed the name of the command to document."
- :type 'function
- :group 'pcomplete)
+ :type 'function)
-(defcustom pcomplete-compare-entry-function 'string-lessp
+(defcustom pcomplete-compare-entry-function #'string-lessp
"This function is used to order file entries for completion.
The behavior of most all shells is to sort alphabetically."
:type '(radio (function-item string-lessp)
(function-item file-newer-than-file-p)
- (function :tag "Other"))
- :group 'pcomplete)
+ (function :tag "Other")))
(defcustom pcomplete-help nil
"A string or function (or nil) used for context-sensitive help.
@@ -188,8 +180,7 @@ If non-nil, it must a sexp that will be evaluated, and whose
result will be shown in the minibuffer.
If nil, the function `pcomplete-man-function' will be called with the
current command argument."
- :type '(choice string sexp (const :tag "Use man page" nil))
- :group 'pcomplete)
+ :type '(choice string sexp (const :tag "Use man page" nil)))
(defcustom pcomplete-expand-before-complete nil
"If non-nil, expand the current argument before completing it.
@@ -199,11 +190,10 @@ resolved first, and the resultant value that will be
completed against
to be inserted in the buffer. Note that exactly what gets expanded
and how is entirely up to the behavior of the
`pcomplete-parse-arguments-function'."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(defcustom pcomplete-parse-arguments-function
- 'pcomplete-parse-buffer-arguments
+ #'pcomplete-parse-buffer-arguments
"A function to call to parse the current line's arguments.
It should be called with no parameters, and with point at the position
of the argument that is to be completed.
@@ -218,8 +208,7 @@ representation of that argument), and BEG-POS gives the
beginning
position of each argument, as it is seen by the user. The establishes
a relationship between the fully resolved value of the argument, and
the textual representation of the argument."
- :type 'function
- :group 'pcomplete)
+ :type 'function)
(defcustom pcomplete-cycle-completions t
"If non-nil, hitting the TAB key cycles through the completion list.
@@ -230,8 +219,7 @@ it acts more like zsh or 4nt, showing the first maximal
match first,
followed by any further matches on each subsequent pressing of the TAB
key. \\[pcomplete-list] is the key to press if the user wants to see
the list of possible completions."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(defcustom pcomplete-cycle-cutoff-length 5
"If the number of completions is greater than this, don't cycle.
@@ -246,8 +234,7 @@ has already entered enough input to disambiguate most of the
possibilities, and therefore they are probably most interested in
cycling through the candidates. Set this value to nil if you want
cycling to always be enabled."
- :type '(choice integer (const :tag "Always cycle" nil))
- :group 'pcomplete)
+ :type '(choice integer (const :tag "Always cycle" nil)))
(defcustom pcomplete-restore-window-delay 1
"The number of seconds to wait before restoring completion windows.
@@ -258,15 +245,13 @@ displayed will be restored), after this many seconds of
idle time. If
set to nil, completion windows will be left on second until the user
removes them manually. If set to 0, they will disappear immediately
after the user enters a key other than TAB."
- :type '(choice integer (const :tag "Never restore" nil))
- :group 'pcomplete)
+ :type '(choice integer (const :tag "Never restore" nil)))
(defcustom pcomplete-try-first-hook nil
"A list of functions which are called before completing an argument.
This can be used, for example, for completing things which might apply
to all arguments, such as variable names after a $."
- :type 'hook
- :group 'pcomplete)
+ :type 'hook)
(defsubst pcomplete-executables (&optional regexp)
"Complete amongst a list of directories and executables."
@@ -310,13 +295,11 @@ generate the completions list. This means that the hook
(lambda ()
(pcomplete-here (pcomplete-executables))))
"Function called for completing the initial command argument."
- :type 'function
- :group 'pcomplete)
+ :type 'function)
-(defcustom pcomplete-command-name-function 'pcomplete-command-name
+(defcustom pcomplete-command-name-function #'pcomplete-command-name
"Function called for determining the current command name."
- :type 'function
- :group 'pcomplete)
+ :type 'function)
(defcustom pcomplete-default-completion-function
(function
@@ -324,16 +307,14 @@ generate the completions list. This means that the hook
(while (pcomplete-here (pcomplete-entries)))))
"Function called when no completion rule can be found.
This function is used to generate completions for every argument."
- :type 'function
- :group 'pcomplete)
+ :type 'function)
(defcustom pcomplete-use-paring t
"If t, pare alternatives that have already been used.
If nil, you will always see the completion set of possible options, no
matter which of those options have already been used in previous
command arguments."
- :type 'boolean
- :group 'pcomplete)
+ :type 'boolean)
(defcustom pcomplete-termination-string " "
"A string that is inserted after any completion or expansion.
@@ -342,8 +323,7 @@ words separated by spaces. However, if your list uses a
different
separator character, or if the completion occurs in a word that is
already terminated by a character, this variable should be locally
modified to be an empty string, or the desired separation string."
- :type 'string
- :group 'pcomplete)
+ :type 'string)
;;; Internal Variables:
@@ -459,7 +439,7 @@ Same as `pcomplete' but using the standard completion UI."
;; between pcomplete-stub and the buffer's text is simply due to
;; some chars removed by unquoting. Again, this is not
;; indispensable but reduces the reliance on c-t-subvert and
- ;; improves corner case behaviors.
+ ;; improves corner case behaviors. See e.g. bug#34888.
(while (progn (setq buftext (pcomplete-unquote-argument
(buffer-substring beg (point))))
(and (> beg argbeg)
@@ -501,6 +481,10 @@ Same as `pcomplete' but using the standard completion UI."
(setq table (completion-table-case-fold table)))
(list beg (point) table
:predicate pred
+ ;; FIXME: This might be useful even if `completions' is nil!
+ :context-help-function
+ (let ((ph pcomplete-help)) ;;Preserve the current value.
+ (lambda () (let ((pcomplete-help ph)) (pcomplete--help))))
:exit-function
;; If completion is finished, add a terminating space.
;; We used to also do this if STATUS is `sole', but
@@ -528,6 +512,7 @@ Same as `pcomplete' but using the standard completion UI."
"Support extensible programmable completion.
To use this function, just bind the TAB key to it, or add it to your
completion functions list (it should occur fairly early in the list)."
+ (declare (obsolete "use `completion-at-point' with
`pcomplete-completions-at-point' instead" "27.1"))
(interactive "p")
(if (and interactively
pcomplete-cycle-completions
@@ -570,6 +555,7 @@ completion functions list (it should occur fairly early in
the list)."
;;;###autoload
(defun pcomplete-reverse ()
"If cycling completion is in use, cycle backwards."
+ (declare (obsolete ?? "27.1"))
(interactive)
(call-interactively 'pcomplete))
@@ -577,6 +563,7 @@ completion functions list (it should occur fairly early in
the list)."
(defun pcomplete-expand-and-complete ()
"Expand the textual value of the current argument.
This will modify the current buffer."
+ (declare (obsolete "use pcomplete-expand and completion-at-point" "27.1"))
(interactive)
(let ((pcomplete-expand-before-complete t))
(pcomplete)))
@@ -584,6 +571,8 @@ This will modify the current buffer."
;;;###autoload
(defun pcomplete-continue ()
"Complete without reference to any cycling completions."
+ ;; It doesn't seem to be used, so it's OK if we don't have a substitute.
+ (declare (obsolete nil "27.1"))
(interactive)
(setq pcomplete-current-completions nil
pcomplete-last-completion-raw nil)
@@ -594,30 +583,41 @@ This will modify the current buffer."
"Expand the textual value of the current argument.
This will modify the current buffer."
(interactive)
- (let ((pcomplete-expand-before-complete t)
- (pcomplete-expand-only-p t))
- (pcomplete)
- (when (and pcomplete-current-completions
- (> (length pcomplete-current-completions) 0)) ;??
- (delete-char (- pcomplete-last-completion-length))
- (while pcomplete-current-completions
- (unless (pcomplete-insert-entry
- "" (car pcomplete-current-completions) t
- pcomplete-last-completion-raw)
- (insert-and-inherit pcomplete-termination-string))
- (setq pcomplete-current-completions
- (cdr pcomplete-current-completions))))))
+ (setq pcomplete-current-completions nil
+ pcomplete-last-completion-raw nil)
+ (catch 'pcompleted
+ (let* ((pcomplete-stub)
+ pcomplete-seen pcomplete-norm-func
+ pcomplete-args pcomplete-last pcomplete-index
+ (pcomplete-autolist pcomplete-autolist)
+ (pcomplete-suffix-list pcomplete-suffix-list)
+ (pcomplete-expand-only-p t))
+ (pcomplete-parse-arguments 'expand-before-complete)))
+ ;; FIXME: What is this doing?
+ (when (and pcomplete-current-completions
+ (> (length pcomplete-current-completions) 0)) ;??
+ (delete-char (- pcomplete-last-completion-length))
+ (dolist (c (prog1 pcomplete-current-completions
+ (setq pcomplete-current-completions nil)))
+ (unless (pcomplete-insert-entry "" c t
+ pcomplete-last-completion-raw)
+ (insert-and-inherit pcomplete-termination-string)))))
;;;###autoload
(defun pcomplete-help ()
"Display any help information relative to the current argument."
- (interactive)
- (let ((pcomplete-show-help t))
- (pcomplete)))
+ (interactive) ;FIXME!
+ ;; (declare (obsolete ?? "27.1"))
+ (let* ((data (pcomplete-completions-at-point))
+ (helpfun (plist-get (nthcdr 3 data) :context-help-function)))
+ (if helpfun
+ (funcall helpfun)
+ (message "No context-sensitive help available"))))
;;;###autoload
(defun pcomplete-list ()
"Show the list of possible completions for the current argument."
+ (declare (obsolete completion-help-at-point "27.1"))
(interactive)
(when (and pcomplete-cycle-completions
pcomplete-current-completions
@@ -751,9 +751,9 @@ COMPLETEF-SYM should be the symbol where the
dynamic-complete-functions are kept. For comint mode itself,
this is `comint-dynamic-complete-functions'."
(set (make-local-variable 'pcomplete-parse-arguments-function)
- 'pcomplete-parse-comint-arguments)
+ #'pcomplete-parse-comint-arguments)
(add-hook 'completion-at-point-functions
- 'pcomplete-completions-at-point nil 'local)
+ #'pcomplete-completions-at-point nil 'local)
(set (make-local-variable completef-sym)
(copy-sequence (symbol-value completef-sym)))
(let* ((funs (symbol-value completef-sym))
@@ -915,12 +915,12 @@ component, `default-directory' is used as the basis for
completion."
(or (eq action t)
(eq (car-safe action) 'boundaries))))
(let ((newstring
- (mapconcat 'identity (nreverse (cons string strings)) "")))
+ (mapconcat #'identity (nreverse (cons string strings)) "")))
;; FIXME: We could also try to return unexpanded envvars.
(complete-with-action action table newstring pred))
(let* ((envpos (apply #'+ (mapcar #' length strings)))
(newstring
- (mapconcat 'identity (nreverse (cons string strings)) ""))
+ (mapconcat #'identity (nreverse (cons string strings)) ""))
(bounds (completion-boundaries newstring table pred
(or (cdr-safe action) ""))))
(if (>= (car bounds) envpos)
@@ -1181,12 +1181,12 @@ extra checking, and munging of the COMPLETIONS list."
;; pare it down, if applicable
(when (and pcomplete-use-paring pcomplete-seen)
(setq pcomplete-seen
- (mapcar 'directory-file-name pcomplete-seen))
+ (mapcar #'directory-file-name pcomplete-seen))
(dolist (p pcomplete-seen)
(add-to-list 'pcomplete-seen
(funcall pcomplete-norm-func p)))
(setq completions
- (apply-partially 'completion-table-with-predicate
+ (apply-partially #'completion-table-with-predicate
completions
(when pcomplete-seen
(lambda (f)
@@ -1262,20 +1262,21 @@ See also `pcomplete-filename'."
(defun pcomplete--help ()
"Produce context-sensitive help for the current argument.
If specific documentation can't be given, be generic."
- (if (and pcomplete-help
- (or (and (stringp pcomplete-help)
- (fboundp 'Info-goto-node))
- (listp pcomplete-help)))
- (if (listp pcomplete-help)
- (message "%s" (eval pcomplete-help))
- (save-window-excursion (info))
- (switch-to-buffer-other-window "*info*")
- (funcall (symbol-function 'Info-goto-node) pcomplete-help))
+ (cond
+ ((functionp pcomplete-help) (funcall pcomplete-help))
+ ((consp pcomplete-help)
+ (message "%s" (eval pcomplete-help t)))
+ ((and (stringp pcomplete-help)
+ (fboundp 'Info-goto-node))
+ (save-window-excursion (info))
+ (switch-to-buffer-other-window "*info*")
+ (Info-goto-node pcomplete-help))
+ (t
(if pcomplete-man-function
(let ((cmd (funcall pcomplete-command-name-function)))
(if (and cmd (> (length cmd) 0))
(funcall pcomplete-man-function cmd)))
- (message "No context-sensitive help available"))))
+ (message "No context-sensitive help available")))))
;; general utilities
@@ -1292,12 +1293,12 @@ If specific documentation can't be given, be generic."
l)
(define-obsolete-function-alias
'pcomplete-uniqify-list
- 'pcomplete-uniquify-list "27.1")
+ #'pcomplete-uniquify-list "27.1")
(defun pcomplete-process-result (cmd &rest args)
"Call CMD using `call-process' and return the simplest result."
(with-temp-buffer
- (apply 'call-process cmd nil t nil args)
+ (apply #'call-process cmd nil t nil args)
(skip-chars-backward "\n")
(buffer-substring (point-min) (point))))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 5c18879..8d6cce6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -525,6 +525,8 @@ preferably use the `c-mode-menu' language constant
directly."
;; and `after-change-functions'. Note that this variable is not set when
;; `c-before-change' is invoked by a change to text properties.
+(defvar c--use-syntax-propertize t)
+
(defun c-basic-common-init (mode default-style)
"Do the necessary initialization for the syntax handling routines
and the line breaking/filling code. Intended to be used by other
@@ -669,15 +671,20 @@ that requires a literal mode spec at compile time."
;; Install the functions that ensure that various internal caches
;; don't become invalid due to buffer changes.
- (when (featurep 'xemacs)
- (make-local-hook 'before-change-functions)
- (make-local-hook 'after-change-functions))
- (add-hook 'before-change-functions 'c-before-change nil t)
- (setq c-just-done-before-change nil)
- ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of -10
- ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
- ;; c-after-font-lock-init.
- (add-hook 'after-change-functions 'c-after-change nil t)
+ (if c--use-syntax-propertize
+ (setq-local syntax-propertize-function
+ (lambda (start end)
+ (c-before-change start (point-max))
+ (c-after-change start end (- end start))))
+ (when (featurep 'xemacs)
+ (make-local-hook 'before-change-functions)
+ (make-local-hook 'after-change-functions))
+ (add-hook 'before-change-functions 'c-before-change nil t)
+ (setq c-just-done-before-change nil)
+ ;; FIXME: We should use the new `depth' arg in Emacs-27 (e.g. a depth of
-10
+ ;; would do since font-lock uses a(n implicit) depth of 0) so we don't need
+ ;; c-after-font-lock-init.
+ (add-hook 'after-change-functions 'c-after-change nil t))
(when (boundp 'font-lock-extend-after-change-region-function)
(set (make-local-variable 'font-lock-extend-after-change-region-function)
'c-extend-after-change-region))) ; Currently (2009-05) used by all
@@ -735,15 +742,17 @@ compatible with old code; callers should always specify
it."
(widen)
(setq c-new-BEG (point-min))
(setq c-new-END (point-max))
- (save-excursion
- (let (before-change-functions after-change-functions)
- (mapc (lambda (fn)
- (funcall fn (point-min) (point-max)))
- c-get-state-before-change-functions)
- (mapc (lambda (fn)
- (funcall fn (point-min) (point-max)
- (- (point-max) (point-min))))
- c-before-font-lock-functions))))
+ (unless c--use-syntax-propertize
+ (save-excursion
+ (let (before-change-functions after-change-functions)
+ (mapc (lambda (fn)
+ (funcall fn (point-min) (point-max)))
+ c-get-state-before-change-functions)
+ (mapc (lambda (fn)
+ (funcall fn (point-min) (point-max)
+ (- (point-max) (point-min))))
+ c-before-font-lock-functions)
+ ))))
(set (make-local-variable 'outline-regexp) "[^#\n\^M]")
(set (make-local-variable 'outline-level) 'c-outline-level)
@@ -2050,6 +2059,12 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;;
;; Type a space in the first blank line, and the fontification of the next
;; line was fouled up by context fontification.
+ (when c--use-syntax-propertize
+ ;; This should also update c-new-END and c-new-BEG.
+ (syntax-propertize end)
+ ;; FIXME: Apparently `c-new-END' may be left unchanged to a stale value,
+ ;; presumably when the buffer gets truncated.
+ (if (> c-new-END (point-max)) (setq c-new-END (point-max))))
(let (new-beg new-end new-region case-fold-search)
(if (and c-in-after-change-fontification
(< beg c-new-END) (> end c-new-BEG))
@@ -2088,7 +2103,8 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
;; function will get executed before the font-lock one.
- (when (memq #'c-after-change after-change-functions)
+ (when (and c--use-syntax-propertize
+ (memq #'c-after-change after-change-functions))
(remove-hook 'after-change-functions #'c-after-change t)
(add-hook 'after-change-functions #'c-after-change nil t)))
@@ -2142,11 +2158,14 @@ This function is called from `c-common-init', once per
mode initialization."
(when (eq font-lock-support-mode 'jit-lock-mode)
(save-restriction
(widen)
+ ;; FIXME: This presumes that c-new-BEG and c-new-END have been set
+ ;; I guess from the before-change-function.
(c-save-buffer-state () ; Protect the undo-list from put-text-property.
(if (< c-new-BEG beg)
(put-text-property c-new-BEG beg 'fontified nil))
(if (> c-new-END end)
- (put-text-property end c-new-END 'fontified nil)))))
+ (put-text-property end (min c-new-END (point-max))
+ 'fontified nil)))))
(cons c-new-BEG c-new-END))
;; Emacs < 22 and XEmacs
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 254269d..d5ef37a 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -480,8 +480,7 @@ Older version of this page was called `perl5', newer
`perl'."
:type 'string
:group 'cperl-help-system)
-(defcustom cperl-use-syntax-table-text-property
- (boundp 'parse-sexp-lookup-properties)
+(defcustom cperl-use-syntax-table-text-property t
"Non-nil means CPerl sets up and uses `syntax-table' text property."
:type 'boolean
:group 'cperl-speed)
@@ -700,55 +699,7 @@ install choose-color.el, available from
`fill-paragraph' on a comment may leave the point behind the
paragraph. It also triggers a bug in some versions of Emacs (CPerl tries
-to detect it and bulk out).
-
-See documentation of a variable `cperl-problems-old-emaxen' for the
-problems which disappear if you upgrade Emacs to a reasonably new
-version (20.3 for Emacs, and those of 2004 for XEmacs).")
-
-(defvar cperl-problems-old-emaxen 'please-ignore-this-line
- "Description of problems in CPerl mode specific for older Emacs versions.
-
-Emacs had a _very_ restricted syntax parsing engine until version
-20.1. Most problems below are corrected starting from this version of
-Emacs, and all of them should be fixed in version 20.3. (Or apply
-patches to Emacs 19.33/34 - see tips.) XEmacs was very backward in
-this respect (until 2003).
-
-Note that even with newer Emacsen in some very rare cases the details
-of interaction of `font-lock' and syntaxification may be not cleaned
-up yet. You may get slightly different colors basing on the order of
-fontification and syntaxification. Say, the initial faces is correct,
-but editing the buffer breaks this.
-
-Even with older Emacsen CPerl mode tries to corrects some Emacs
-misunderstandings, however, for efficiency reasons the degree of
-correction is different for different operations. The partially
-corrected problems are: POD sections, here-documents, regexps. The
-operations are: highlighting, indentation, electric keywords, electric
-braces.
-
-This may be confusing, since the regexp s#//#/#; may be highlighted
-as a comment, but it will be recognized as a regexp by the indentation
-code. Or the opposite case, when a POD section is highlighted, but
-may break the indentation of the following code (though indentation
-should work if the balance of delimiters is not broken by POD).
-
-The main trick (to make $ a \"backslash\") makes constructions like
-${aaa} look like unbalanced braces. The only trick I can think of is
-to insert it as $ {aaa} (valid in perl5, not in perl4).
-
-Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
-as /($|\\s)/. Note that such a transposition is not always possible.
-
-The solution is to upgrade your Emacs or patch an older one. Note
-that Emacs 20.2 has some bugs related to `syntax-table' text
-properties. Patches are available on the main CPerl download site,
-and on CPAN.
-
-If these bugs cannot be fixed on your machine (say, you have an inferior
-environment and cannot recompile), you may still disable all the fancy stuff
-via `cperl-use-syntax-table-text-property'.")
+to detect it and bulk out).")
(defvar cperl-praise 'please-ignore-this-line
"Advantages of CPerl mode.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4306f5d..30c9b81 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -152,7 +152,8 @@ Used to gray out relevant toolbar icons.")
(bound-and-true-p
gdb-active-process)))))
([go] menu-item (if (bound-and-true-p gdb-active-process)
- "Continue" "Run") gud-go
+ "Continue" "Run")
+ gud-go
:visible (and (eq gud-minor-mode 'gdbmi)
(gdb-show-run-p)))
([stop] menu-item "Stop" gud-stop-subjob
@@ -190,7 +191,8 @@ Used to gray out relevant toolbar icons.")
(eq gud-minor-mode 'gdbmi)))
([print*] menu-item (if (eq gud-minor-mode 'jdb)
"Dump object"
- "Print Dereference") gud-pstar
+ "Print Dereference")
+ gud-pstar
:enable (not gud-running)
:visible (memq gud-minor-mode '(gdbmi gdb jdb)))
([print] menu-item "Print Expression" gud-print
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index aa41230..33c69e1 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -33,12 +33,11 @@
;;; Added by Tom Perrine (TEP)
(defvar m2-mode-syntax-table
(let ((table (make-syntax-table)))
+ ;; FIXME: nesting!
+ ;; FIXME: `comment-indent' just inserts "(**)" whereas the old code
+ ;; resulted in a nicer "(* *)"!
+ (comment-set-syntax table '(("(*" . "*)") ("//" . "\n")))
(modify-syntax-entry ?\\ "\\" table)
- (modify-syntax-entry ?/ ". 12" table)
- (modify-syntax-entry ?\n ">" table)
- (modify-syntax-entry ?\( "()1" table)
- (modify-syntax-entry ?\) ")(4" table)
- (modify-syntax-entry ?* ". 23nb" table)
(modify-syntax-entry ?+ "." table)
(modify-syntax-entry ?- "." table)
(modify-syntax-entry ?= "." table)
@@ -204,10 +203,11 @@
(let ((tok (smie-default-backward-token)))
(cond
((zerop (length tok))
- (let ((forward-sexp-function nil))
- (condition-case nil
- (forward-sexp -1)
- (scan-error (setq res ":")))))
+ (if (bobp) (setq res ":")
+ (let ((forward-sexp-function nil))
+ (condition-case nil
+ (forward-sexp -1)
+ (scan-error (setq res ":"))))))
((member tok '("|" "OF" "..")) (setq res ":-case"))
((member tok '(":" "END" ";" "BEGIN" "VAR" "RECORD" "PROCEDURE"))
(setq res ":")))))
@@ -311,9 +311,6 @@ followed by the first character of the construct.
(set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'comment-start) "(* ")
- (set (make-local-variable 'comment-end) " *)")
- (set (make-local-variable 'comment-start-skip) "\\(?:(\\*+\\|//+\\) *")
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'font-lock-defaults)
'((m3-font-lock-keywords
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index e1f9a33..28d8746 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -628,7 +628,8 @@ builtins.")
;; OS specific
"VMSError" "WindowsError"
)
- symbol-end) . font-lock-type-face)
+ symbol-end)
+ . font-lock-type-face)
;; assignments
;; support for a = b = c = 5
(,(lambda (limit)
@@ -678,6 +679,7 @@ Which one will be chosen depends on the value of
((rx (or "\"\"\"" "'''"))
(0 (ignore (python-syntax-stringify))))))
+;; Always define the alias(es) *before* the variable.
(define-obsolete-variable-alias 'python--prettify-symbols-alist
'python-prettify-symbols-alist "26.1")
diff --git a/lisp/startup.el b/lisp/startup.el
index 7759ed5..2b4f4c7 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -980,6 +980,13 @@ XDG convention for dotfiles."
(found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
found-path))
+(defcustom gc-cons-opportunistic-idle-time 5
+ "Number of seconds before trying an opportunistic GC.
+After this number of seconds of idle time, Emacs tries to collect
+garbage more eagerly (i.e. with thresholds halved) in the hope
+to avoid running the GC later during non-idle time."
+ :type 'integer)
+
(defun command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
@@ -1377,6 +1384,16 @@ please check its value")
(eq face-ignored-fonts old-face-ignored-fonts))
(clear-face-cache)))
+ ;; Start opportunistic GC (after loading the init file, so we obey
+ ;; its settings). This is desirable for two reason:
+ ;; - It reduces the number of times we have to GC in the middle of
+ ;; an operation.
+ ;; - It means we GC when the C stack is short, reducing the risk of false
+ ;; positives from the conservative stack scanning.
+ (when gc-cons-opportunistic-idle-time
+ (run-with-idle-timer gc-cons-opportunistic-idle-time t
+ #'garbage-collect-maybe 2))
+
(setq after-init-time (current-time))
;; Display any accumulated warnings after all functions in
;; `after-init-hook' like `desktop-read' have finalized possible
diff --git a/lisp/subr.el b/lisp/subr.el
index baff1e9..3f5e1d7 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -825,11 +825,11 @@ Example:
"Return a copy of SEQ with all occurrences of ELT removed.
SEQ must be a list, vector, or string. The comparison is done with `equal'."
(declare (side-effect-free t))
- (if (nlistp seq)
- ;; If SEQ isn't a list, there's no need to copy SEQ because
- ;; `delete' will return a new object.
- (delete elt seq)
- (delete elt (copy-sequence seq))))
+ (delete elt (if (nlistp seq)
+ ;; If SEQ isn't a list, there's no need to copy SEQ because
+ ;; `delete' will return a new object.
+ seq
+ (copy-sequence seq))))
(defun remq (elt list)
"Return LIST with all occurrences of ELT removed.
@@ -851,10 +851,10 @@ This is the same format used for saving keyboard macros
(see
`edmacro-mode').
For an approximate inverse of this, see `key-description'."
+ (declare (pure t))
;; Don't use a defalias, since the `pure' property is only true for
;; the calling convention of `kbd'.
(read-kbd-macro keys))
-(put 'kbd 'pure t)
(defun undefined ()
"Beep to tell the user this binding is undefined."
@@ -5586,6 +5586,17 @@ returned list are in the same order as in TREE.
(defalias 'flatten-list 'flatten-tree)
;; The initial anchoring is for better performance in searching matches.
+(defun internal--opportunistic-gc ()
+ "Run the GC during idle time."
+ (let ((gc-cons-threshold (/ gc-cons-threshold 2))
+ ;; FIXME: This doesn't work because it's only consulted at the end
+ ;; of a GC in order to set the next `gc_relative_threshold'!
+ (gc-cons-percentage (/ gc-cons-percentage 2)))
+ ;; HACK ATTACK: the purpose of this dummy call to `eval' is to call
+ ;; `maybe_gc', so we will trigger a GC if we allocated half of the maximum
+ ;; allowed before the GC is forced upon us.
+ (eval 1 t)))
+
(defconst regexp-unmatchable "\\`a\\`"
"Standard regexp guaranteed not to match any string at all.")
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index c4b0a8f..d612217 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1107,6 +1107,7 @@ versions of xterm."
(t (error "Unsupported number of xterm colors (%d)" (+ 16 ncolors)))))
;; Modifying color mappings means realized faces don't use the
;; right colors, so clear them.
+ ;; FIXME: Only for the selected frame!
(clear-face-cache)))
(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 5d5d787..19e0039 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1115,7 +1115,7 @@ to exclude some SCSS constructs."
(goto-char start-point)
(forward-comment (- (point)))
(skip-chars-backward "@[:alpha:]")
- (unless (looking-at-p "@\\(mixin\\|include\\)")
+ (unless (looking-at-p "@\\(?:mixin\\|include\\)")
(cdr color)))))
(defun css--compute-color (start-point match)
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index c285491..7d951ff 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -900,6 +900,12 @@ region, instead of just filling the current paragraph."
(equal hash (buffer-hash)))
(set-buffer-modified-p nil)))))
+(defun unfill-paragraph ()
+ "That thing."
+ (interactive)
+ (let ((fill-column (/ most-positive-fixnum 2)))
+ (fill-paragraph)))
+
(declare-function comment-search-forward "newcomment" (limit &optional
noerror))
(declare-function comment-string-strip "newcomment" (str beforep afterp))
diff --git a/lisp/window.el b/lisp/window.el
index 726d022..00523d5 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6485,7 +6485,7 @@ pass the elements of (cdr ARGS) as the remaining
arguments."
(set-window-dedicated-p window t)
window)))))
-(defcustom special-display-function 'special-display-popup-frame
+(defcustom special-display-function #'special-display-popup-frame
"Function to call for displaying special buffers.
This function is called with two arguments - the buffer and,
optionally, a list - and should return a window displaying that
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 5ff7182..a330604 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -84,7 +84,7 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)."
(setf (terminal-parameter nil 'xterm-mouse-last-down) nil)
(cond
((null down)
- ;; This is an "up-only" event. Pretend there was an up-event
+ ;; This is an "up-only" event. Pretend there was a down-event
;; right before and keep the up-event for later.
(push event unread-command-events)
(vector (cons (intern (replace-regexp-in-string
diff --git a/src/alloc.c b/src/alloc.c
index 64aaa8a..86ecf52 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5989,6 +5989,28 @@ garbage_collect (void)
garbage_collect_1 (&gcst);
}
+DEFUN ("garbage-collect-maybe", Fgarbage_collect_maybe,
Sgarbage_collect_maybe, 1, 1, "",
+ doc: /* Call `garbage-collect' if enough allocation happened.
+FACTOR determines what "enough" means here:
+a FACTOR of N means to run the GC if more than 1/Nth of the allocations
+needed to triger automatic allocation took place. */)
+ (Lisp_Object factor)
+{
+ CHECK_FIXNAT (factor);
+ EMACS_INT fact = XFIXNAT (factor);
+ byte_ct new_csgc = consing_since_gc * fact;
+ if (new_csgc / fact != consing_since_gc)
+ /* Overflow! */
+ garbage_collect ();
+ else
+ {
+ consing_since_gc = new_csgc;
+ maybe_gc ();
+ consing_since_gc /= fact;
+ }
+ return Qnil;
+}
+
DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
doc: /* Reclaim storage for Lisp objects no longer needed.
Garbage collection happens automatically if you cons more than
@@ -7389,6 +7411,7 @@ N should be nonnegative. */);
defsubr (&Smake_finalizer);
defsubr (&Spurecopy);
defsubr (&Sgarbage_collect);
+ defsubr (&Sgarbage_collect_maybe);
defsubr (&Smemory_info);
defsubr (&Smemory_use_counts);
defsubr (&Ssuspicious_object);
diff --git a/src/keyboard.c b/src/keyboard.c
index 56916e0..9e1567f 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2728,7 +2728,7 @@ read_char (int commandflag, Lisp_Object map,
/* If there is still no input available, ask for GC. */
if (!detect_input_pending_run_timers (0))
- maybe_gc ();
+ maybe_gc (); /* FIXME: Why? */
}
/* 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 4f1e572..0b67fb3 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -876,15 +876,6 @@ baz\"\""
(call-interactively (key-binding `[,last-command-event])))
(should (equal (buffer-string) "int main () {\n \n}"))))
-(define-derived-mode plainer-c-mode c-mode "pC"
- "A plainer/saner C-mode with no internal electric machinery."
- (c-toggle-electric-state -1)
- (setq-local electric-indent-local-mode-hook nil)
- (setq-local electric-indent-mode-hook nil)
- (electric-indent-local-mode 1)
- (dolist (key '(?\" ?\' ?\{ ?\} ?\( ?\) ?\[ ?\]))
- (local-set-key (vector key) 'self-insert-command)))
-
(ert-deftest electric-modes-int-main-allman-style ()
(ert-with-test-buffer ()
(plainer-c-mode)
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 35df7cc..428b192 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -74,7 +74,7 @@
'completion-table-with-predicate
full-collection no-A nil))))))
-(ert-deftest completion-table-subvert-test ()
+(ert-deftest completion-table-subvert-test () ;bug#34888
(let* ((origtable '("A-hello" "A-there"))
(subvtable (completion-table-subvert origtable "B" "A")))
(should (equal (try-completion "B-hel" subvtable)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 525f62a..c8fe00d 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'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p)))
-
+ (defvar tramp-display-escape-sequence-regexp) ;Defined in tramp-sh.el
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let* ((tmp-name (tramp--test-make-temp-name nil quoted))
(fnnd (file-name-nondirectory tmp-name))