summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorStephen Leake <stephen_leake@stephe-leake.org>2019-09-10 03:37:51 -0700
committerStephen Leake <stephen_leake@stephe-leake.org>2019-09-10 03:37:51 -0700
commit3d442312889ef2d14c07282d0aff6199d00cc165 (patch)
tree74034ca2dded6ed233d0701b4cb5c10a0b5e9034 /lisp
parentac1a2e260e8ece34500b5879f766b4e54ee57b94 (diff)
parent74e9799bd89484b8d15bdd6597c68fc00d07e7f7 (diff)
downloademacs-3d442312889ef2d14c07282d0aff6199d00cc165.tar.gz
Merge commit '74e9799bd89484b8d15bdd6597c68fc00d07e7f7'
Diffstat (limited to 'lisp')
-rw-r--r--lisp/battery.el23
-rw-r--r--lisp/bookmark.el39
-rw-r--r--lisp/calendar/icalendar.el7
-rw-r--r--lisp/calendar/time-date.el32
-rw-r--r--lisp/cedet/ede/proj.el2
-rw-r--r--lisp/composite.el4
-rw-r--r--lisp/custom.el1
-rw-r--r--lisp/dframe.el21
-rw-r--r--lisp/dired-aux.el1
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el10
-rw-r--r--lisp/emacs-lisp/cl-macs.el38
-rw-r--r--lisp/emacs-lisp/easy-mmode.el38
-rw-r--r--lisp/emacs-lisp/eldoc.el19
-rw-r--r--lisp/emacs-lisp/find-func.el17
-rw-r--r--lisp/emacs-lisp/package.el25
-rw-r--r--lisp/emacs-lisp/rmc.el2
-rw-r--r--lisp/emacs-lisp/subr-x.el4
-rw-r--r--lisp/epa-file.el64
-rw-r--r--lisp/epa.el4
-rw-r--r--lisp/epg-config.el15
-rw-r--r--lisp/epg.el10
-rw-r--r--lisp/erc/erc.el19
-rw-r--r--lisp/files.el4
-rw-r--r--lisp/gnus/gnus-art.el7
-rw-r--r--lisp/gnus/gnus-start.el3
-rw-r--r--lisp/gnus/mml-sec.el8
-rw-r--r--lisp/hi-lock.el2
-rw-r--r--lisp/ibuf-ext.el3
-rw-r--r--lisp/image-mode.el10
-rw-r--r--lisp/info.el57
-rw-r--r--lisp/international/quail.el3
-rw-r--r--lisp/ldefs-boot.el201
-rw-r--r--lisp/ls-lisp.el3
-rw-r--r--lisp/macros.el14
-rw-r--r--lisp/mail/flow-fill.el3
-rw-r--r--lisp/net/browse-url.el4
-rw-r--r--lisp/net/gnutls.el37
-rw-r--r--lisp/net/net-utils.el75
-rw-r--r--lisp/net/nsm.el1133
-rw-r--r--lisp/net/shr.el9
-rw-r--r--lisp/net/tramp-sh.el14
-rw-r--r--lisp/net/tramp.el7
-rw-r--r--lisp/play/gamegrid.el3
-rw-r--r--lisp/progmodes/compile.el111
-rw-r--r--lisp/progmodes/flymake-proc.el14
-rw-r--r--lisp/progmodes/gud.el4
-rw-r--r--lisp/progmodes/hideif.el18
-rw-r--r--lisp/progmodes/prog-mode.el3
-rw-r--r--lisp/progmodes/xref.el25
-rw-r--r--lisp/ps-print.el11
-rw-r--r--lisp/recentf.el3
-rw-r--r--lisp/server.el3
-rw-r--r--lisp/shadowfile.el17
-rw-r--r--lisp/shell.el9
-rw-r--r--lisp/simple.el23
-rw-r--r--lisp/skeleton.el4
-rw-r--r--lisp/sort.el16
-rw-r--r--lisp/startup.el78
-rw-r--r--lisp/subr.el8
-rw-r--r--lisp/tar-mode.el5
-rw-r--r--lisp/textmodes/ispell.el7
-rw-r--r--lisp/tmm.el18
-rw-r--r--lisp/vc/vc-hg.el18
-rw-r--r--lisp/wid-edit.el32
-rw-r--r--lisp/window.el12
66 files changed, 1677 insertions, 759 deletions
diff --git a/lisp/battery.el b/lisp/battery.el
index 7037d07dcf0..0ef6d37b406 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -38,19 +38,21 @@
:prefix "battery-"
:group 'hardware)
-(defcustom battery-linux-sysfs-regexp "[bB][aA][tT][0-9]?$"
- "Regexp for folder names to be searched under
- /sys/class/power_supply/ that contain battery information."
- :version "26.1"
- :type 'regexp
- :group 'battery)
-
(defcustom battery-upower-device "battery_BAT1"
"Upower battery device name."
:version "26.1"
:type 'string
:group 'battery)
+(defun battery--find-linux-sysfs-batteries ()
+ (let ((dirs nil))
+ (dolist (file (directory-files "/sys/class/power_supply/" t))
+ (when (and (or (file-directory-p file)
+ (file-symlink-p file))
+ (file-exists-p (expand-file-name "capacity" file)))
+ (push file dirs)))
+ (nreverse dirs)))
+
(defcustom battery-status-function
(cond ((and (eq system-type 'gnu/linux)
(file-readable-p "/proc/apm"))
@@ -60,8 +62,7 @@
#'battery-linux-proc-acpi)
((and (eq system-type 'gnu/linux)
(file-directory-p "/sys/class/power_supply/")
- (directory-files "/sys/class/power_supply/" nil
- battery-linux-sysfs-regexp))
+ (battery--find-linux-sysfs-batteries))
#'battery-linux-sysfs)
((and (eq system-type 'berkeley-unix)
(file-executable-p "/usr/sbin/apm"))
@@ -449,9 +450,7 @@ The following %-sequences are provided:
;; available information together.
(with-temp-buffer
(dolist (dir (ignore-errors
- (directory-files
- "/sys/class/power_supply/" t
- battery-linux-sysfs-regexp)))
+ (battery--find-linux-sysfs-batteries)))
(erase-buffer)
(ignore-errors (insert-file-contents
(expand-file-name "uevent" dir)))
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index f564cd6b431..e58e051a39b 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -619,8 +619,8 @@ If POSN is non-nil, record POSN as the point instead of `(point)'."
;; was incorrect in Emacs 22 and Emacs 23.1.)
;;
;; To deal with the change from FIRST format to SECOND, conversion
-;; code was added, and it is still in use. See
-;; `bookmark-maybe-upgrade-file-format'.
+;; code was added, which is no longer used and has been declared
+;; obsolete. See `bookmark-maybe-upgrade-file-format'.
;;
;; No conversion from SECOND to CURRENT is done. Instead, the code
;; handles both formats OK. It must continue to do so.
@@ -640,7 +640,7 @@ You should never need to change this.")
(defun bookmark-alist-from-buffer ()
- "Return a `bookmark-alist' (in any format) from the current buffer.
+ "Return a `bookmark-alist' from the current buffer.
The buffer must of course contain bookmark format information.
Does not care from where in the buffer it is called, and does not
affect point."
@@ -648,19 +648,13 @@ affect point."
(goto-char (point-min))
(if (search-forward bookmark-end-of-version-stamp-marker nil t)
(read (current-buffer))
- ;; Else we're dealing with format version 0
- (if (search-forward "(" nil t)
- (progn
- (forward-char -1)
- (read (current-buffer)))
- ;; Else no hope of getting information here.
- (if buffer-file-name
- (error "File not in bookmark format: %s" buffer-file-name)
- (error "Buffer not in bookmark format: %s" (buffer-name)))))))
-
+ (if buffer-file-name
+ (error "File not in bookmark format: %s" buffer-file-name)
+ (error "Buffer not in bookmark format: %s" (buffer-name))))))
(defun bookmark-upgrade-version-0-alist (old-list)
"Upgrade a version 0 alist OLD-LIST to the current version."
+ (declare (obsolete nil "27.1"))
(mapcar
(lambda (bookmark)
(let* ((name (car bookmark))
@@ -683,11 +677,14 @@ affect point."
(defun bookmark-upgrade-file-format-from-0 ()
"Upgrade a bookmark file of format 0 (the original format) to format 1.
This expects to be called from `point-min' in a bookmark file."
+ (declare (obsolete nil "27.1"))
(let* ((reporter (make-progress-reporter
(format "Upgrading bookmark format from 0 to %d..."
- bookmark-file-format-version)))
+ bookmark-file-format-version)))
(old-list (bookmark-alist-from-buffer))
- (new-list (bookmark-upgrade-version-0-alist old-list)))
+ (new-list (with-suppressed-warnings
+ ((obsolete bookmark-upgrade-version-0-alist))
+ (bookmark-upgrade-version-0-alist old-list))))
(delete-region (point-min) (point-max))
(bookmark-insert-file-format-version-stamp buffer-file-coding-system)
(pp new-list (current-buffer))
@@ -699,6 +696,7 @@ This expects to be called from `point-min' in a bookmark file."
(defun bookmark-grok-file-format-version ()
"Return an integer which is the file-format version of this bookmark file.
This expects to be called from `point-min' in a bookmark file."
+ (declare (obsolete nil "27.1"))
(if (looking-at "^;;;;")
(save-excursion
(save-match-data
@@ -714,12 +712,18 @@ This expects to be called from `point-min' in a bookmark file."
"Check the file-format version of this bookmark file.
If the version is not up-to-date, upgrade it automatically.
This expects to be called from `point-min' in a bookmark file."
- (let ((version (bookmark-grok-file-format-version)))
+ (declare (obsolete nil "27.1"))
+ (let ((version
+ (with-suppressed-warnings
+ ((obsolete bookmark-grok-file-format-version))
+ (bookmark-grok-file-format-version))))
(cond
((= version bookmark-file-format-version)
) ; home free -- version is current
((= version 0)
- (bookmark-upgrade-file-format-from-0))
+ (with-suppressed-warnings
+ ((obsolete bookmark-upgrade-file-format-from-0))
+ (bookmark-upgrade-file-format-from-0)))
(t
(error "Bookmark file format version strangeness")))))
@@ -1541,7 +1545,6 @@ unique numeric suffixes \"<2>\", \"<3>\", etc."
(with-current-buffer (let (enable-local-variables)
(find-file-noselect file))
(goto-char (point-min))
- (bookmark-maybe-upgrade-file-format)
(let ((blist (bookmark-alist-from-buffer)))
(unless (listp blist)
(error "Invalid bookmark list in %s" file))
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 3c46982c7b0..3ae0fcbe977 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -2095,7 +2095,9 @@ written into the buffer `*icalendar-errors*'."
dtstart-zone))
(start-d (icalendar--datetime-to-diary-date
dtstart-dec))
- (start-t (icalendar--datetime-to-colontime dtstart-dec))
+ (start-t (and dtstart
+ (> (length dtstart) 8)
+ (icalendar--datetime-to-colontime dtstart-dec)))
(dtend (icalendar--get-event-property e 'DTEND))
(dtend-zone (icalendar--find-time-zone
(icalendar--get-event-property-attributes
@@ -2148,8 +2150,7 @@ written into the buffer `*icalendar-errors*'."
(icalendar--get-event-property-attributes
e 'DTEND))
"DATE")))
- (icalendar--datetime-to-colontime dtend-dec)
- start-t))
+ (icalendar--datetime-to-colontime dtend-dec)))
(icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d)
(cond
;; recurring event
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index f3d252f03c6..11bd469ae3b 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -421,10 +421,13 @@ changes in daylight saving time are not taken into account."
;; Do the time part, which is pretty simple (except for leap
;; seconds, I guess).
;; Time zone adjustments are basically the same as time adjustments.
- (setq seconds (time-add (+ (* (or (decoded-time-hour delta) 0) 3600)
- (* (or (decoded-time-minute delta) 0) 60)
- (or (decoded-time-zone delta) 0))
- (or (decoded-time-second delta) 0)))
+ (setq seconds (time-convert (or (decoded-time-second delta) 0) t))
+ (setq seconds
+ (time-add seconds
+ (time-convert (+ (* (or (decoded-time-hour delta) 0) 3600)
+ (* (or (decoded-time-minute delta) 0) 60)
+ (or (decoded-time-zone delta) 0))
+ (cdr seconds))))
(decoded-time--alter-second time seconds)
time))
@@ -461,11 +464,16 @@ changes in daylight saving time are not taken into account."
(defun decoded-time--alter-second (time seconds)
"Increase the time in TIME by SECONDS."
- (let* ((secsperday 86400)
- (old (time-add (+ (* 3600 (or (decoded-time-hour time) 0))
- (* 60 (or (decoded-time-minute time) 0)))
- (or (decoded-time-second time) 0)))
- (new (time-add old seconds)))
+ (let* ((time-sec (time-convert (or (decoded-time-second time) 0) t))
+ (time-hz (cdr time-sec))
+ (old (time-add time-sec
+ (time-convert
+ (+ (* 3600 (or (decoded-time-hour time) 0))
+ (* 60 (or (decoded-time-minute time) 0)))
+ time-hz)))
+ (new (time-convert (time-add old seconds) t))
+ (new-hz (cdr new))
+ (secsperday (time-convert 86400 new-hz)))
;; Hm... DST...
(while (time-less-p new 0)
(decoded-time--alter-day time nil)
@@ -474,8 +482,10 @@ changes in daylight saving time are not taken into account."
(decoded-time--alter-day time t)
(setq new (time-subtract new secsperday)))
(let ((sec (time-convert new 'integer)))
- (setf (decoded-time-second time) (time-add (% sec 60)
- (time-subtract new sec))
+ (setf (decoded-time-second time) (time-add
+ (time-convert (% sec 60) new-hz)
+ (time-subtract
+ new (time-convert sec new-hz)))
(decoded-time-minute time) (% (/ sec 60) 60)
(decoded-time-hour time) (/ sec 3600)))))
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 0774a4625b3..59ba3ffcf8c 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -216,7 +216,7 @@ This enables the creation of your target type."
(setq ede-proj-target-alist
(cons (cons name class) ede-proj-target-alist)))))
-(defclass ede-proj-project (eieio-persistent ede-project)
+(defclass ede-proj-project (eieio-persistent ede-project eieio-named)
((extension :initform ".ede")
(file-header-line :initform ";; EDE Project Files are auto generated: Do Not Edit")
(makefile-type :initarg :makefile-type
diff --git a/lisp/composite.el b/lisp/composite.el
index d0f20949438..b3661cc2fa0 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -558,9 +558,9 @@ All non-spacing characters have this function in
;; "Improper" base characters are of the following general
;; categories:
;; Mark (nonspacing, combining, enclosing)
- ;; Separator (space, line, paragraph)
+ ;; Separator (line, paragraph)
;; Other (control, format, surrogate)
- '(Mn Mc Me Zs Zl Zp Cc Cf Cs))
+ '(Mn Mc Me Zl Zp Cc Cf Cs))
nil)
;; A base character and the following non-spacing characters.
diff --git a/lisp/custom.el b/lisp/custom.el
index 9bd9712b65c..2e42ea73c14 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1137,6 +1137,7 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\".
The command `customize-create-theme' writes theme files into this
directory. By default, Emacs searches for custom themes in this
directory first---see `custom-theme-load-path'."
+ :initialize #'custom-initialize-delay
:type 'string
:group 'customize
:version "22.1")
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 72deb0c45e4..91f89e1705f 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -40,7 +40,7 @@
;; * Frame/buffer killing hooks
;; * Mouse-3 position relative menu
;; * Mouse motion, help-echo hacks
-;; * Mouse clicking, double clicking, & XEmacs image clicking hack
+;; * Mouse clicking & double clicking
;; * Mode line hacking
;; * Utilities for use in a program covering:
;; o keymap massage for some actions
@@ -56,7 +56,6 @@
;; 1) (require 'dframe)
;; 2) Variable Setup:
;; -frame-parameters -- Frame parameters for Emacs.
-;; -frame-plist -- Frame parameters for XEmacs.
;; -- Not on parameter lists: They can optionally include width
;; and height. If width or height is not included, then it will
;; be provided to match the originating frame. In general,
@@ -112,13 +111,9 @@
;;; Code:
-;;; Compatibility functions
-;;
-(defalias 'dframe-frame-parameter
- (if (fboundp 'frame-parameter) 'frame-parameter
- (lambda (frame parameter)
- "Return FRAME's PARAMETER value."
- (cdr (assoc parameter (frame-parameters frame))))))
+
+(define-obsolete-function-alias 'dframe-frame-parameter
+ 'frame-parameter "27.1")
;;; Variables
@@ -322,8 +317,8 @@ CREATE-HOOK is a hook to run after creating a frame."
(if (frame-live-p (symbol-value frame-var))
(raise-frame (symbol-value frame-var))
(set frame-var
- (let* ((mh (dframe-frame-parameter dframe-attached-frame
- 'menu-bar-lines))
+ (let* ((mh (frame-parameter dframe-attached-frame
+ 'menu-bar-lines))
(paramsa
;; Only add a guessed height if one is not specified
;; in the input parameters.
@@ -377,8 +372,8 @@ a cons cell indicating a position of the form (LEFT . TOP)."
;; Position dframe.
;; Do no positioning if not on a windowing system,
(unless (or (not window-system) (eq window-system 'pc))
- (let* ((pfx (dframe-frame-parameter parent-frame 'left))
- (pfy (dframe-frame-parameter parent-frame 'top))
+ (let* ((pfx (frame-parameter parent-frame 'left))
+ (pfy (frame-parameter parent-frame 'top))
(pfw (+ (tool-bar-pixel-width parent-frame)
(frame-pixel-width parent-frame)))
(pfh (frame-pixel-height parent-frame))
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6c06d841e7d..a321247b0b6 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -992,6 +992,7 @@ command with a prefix argument (the value does not matter)."
("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -")
("\\.tgz\\'" "" "gzip -dc %i | tar -xf -")
("\\.gz\\'" "" "gunzip")
+ ("\\.lz\\'" "" "lzip -d")
("\\.Z\\'" "" "uncompress")
;; For .z, try gunzip. It might be an old gzip file,
;; or it might be from compact? pack? (which?) but gunzip handles both.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 40b4e2f4671..2fab11c79df 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4071,7 +4071,7 @@ that suppresses all warnings during execution of BODY."
,condition '(fboundp functionp)
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
- ,condition '(boundp default-boundp)))
+ ,condition '(boundp default-boundp local-variable-p)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(append bound-list byte-compile-bound-variables)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 7b22fa8483a..ff096918173 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -110,6 +110,7 @@ a future Emacs interpreter will be able to use it.")
;; These macros are defined here so that they
;; can safely be used in init files.
+;;;###autoload
(defmacro cl-incf (place &optional x)
"Increment PLACE by X (1 by default).
PLACE may be a symbol, or any generalized variable allowed by `setf'.
@@ -129,9 +130,12 @@ The return value is the decremented value of PLACE."
(list 'cl-callf '- place (or x 1))))
(defmacro cl-pushnew (x place &rest keys)
- "(cl-pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
+ "Add X to the list stored in PLACE unless X is already in the list.
+PLACE is a generalized variable that stores a list.
+
+Like (push X PLACE), except that PLACE is unmodified if X is `eql'
+to an element already in the list stored in PLACE.
+
\nKeywords supported: :test :test-not :key
\n(fn X PLACE [KEYWORD VALUE]...)"
(declare (debug
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 05a4192dd9b..a02fae391bc 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2906,7 +2906,16 @@ Supported keywords for slots are:
(error "Duplicate slots named %s in %s" slot name))
(let ((accessor (intern (format "%s%s" conc-name slot)))
(default-value (pop desc))
- (doc (plist-get desc :documentation)))
+ (doc (plist-get desc :documentation))
+ (access-body
+ `(progn
+ ,@(and pred-check
+ (list `(or ,pred-check
+ (signal 'wrong-type-argument
+ (list ',name cl-x)))))
+ ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
+ (if (= pos 0) '(car cl-x)
+ `(nth ,pos cl-x))))))
(push slot slots)
(push default-value defaults)
;; The arg "cl-x" is referenced by name in eg pred-form
@@ -2916,13 +2925,7 @@ Supported keywords for slots are:
slot name
(if doc (concat "\n" doc) ""))
(declare (side-effect-free t))
- ,@(and pred-check
- (list `(or ,pred-check
- (signal 'wrong-type-argument
- (list ',name cl-x)))))
- ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
- (if (= pos 0) '(car cl-x)
- `(nth ,pos cl-x))))
+ ,access-body)
forms)
(when (cl-oddp (length desc))
(push
@@ -2942,11 +2945,18 @@ Supported keywords for slots are:
forms)
(push kw desc)
(setcar defaults nil))))
- (if (plist-get desc ':read-only)
- (push `(gv-define-expander ,accessor
- (lambda (_cl-do _cl-x)
- (error "%s is a read-only slot" ',accessor)))
- forms)
+ (cond
+ ((eq defsym 'defun)
+ (unless (plist-get desc ':read-only)
+ (push `(defun ,(gv-setter accessor) (val cl-x)
+ (setf ,access-body val))
+ forms)))
+ ((plist-get desc ':read-only)
+ (push `(gv-define-expander ,accessor
+ (lambda (_cl-do _cl-x)
+ (error "%s is a read-only slot" ',accessor)))
+ forms))
+ (t
;; For normal slots, we don't need to define a setf-expander,
;; since gv-get can use the compiler macro to get the
;; same result.
@@ -2964,7 +2974,7 @@ Supported keywords for slots are:
;; ,(and pred-check `',pred-check)
;; ,pos)))
;; forms)
- )
+ ))
(if print-auto
(nconc print-func
(list `(princ ,(format " %s" slot) cl-s)
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index be531aab849..bbc3a27504c 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -363,18 +363,21 @@ No problems result if this variable is not bound.
;;;###autoload
(defalias 'define-global-minor-mode 'define-globalized-minor-mode)
;;;###autoload
-(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest keys)
+(defmacro define-globalized-minor-mode (global-mode mode turn-on &rest body)
"Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments. As the minor mode
- defined by this function is always global, any :global keyword is
- ignored. Other keywords have the same meaning as in `define-minor-mode',
- which see. In particular, :group specifies the custom group.
- The most useful keywords are those that are passed on to the
- `defcustom'. It normally makes no sense to pass the :lighter
- or :keymap keywords to `define-globalized-minor-mode', since these
- are usually passed to the buffer-local version of the minor mode.
+Each of KEY VALUE is a pair of CL-style keyword arguments. As
+ the minor mode defined by this function is always global, any
+ :global keyword is ignored. Other keywords have the same
+ meaning as in `define-minor-mode', which see. In particular,
+ :group specifies the custom group. The most useful keywords
+ are those that are passed on to the `defcustom'. It normally
+ makes no sense to pass the :lighter or :keymap keywords to
+ `define-globalized-minor-mode', since these are usually passed
+ to the buffer-local version of the minor mode.
+BODY contains code to execute each time the mode is enabled or disabled.
+ It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -384,7 +387,9 @@ call another major mode in their body.
When a major mode is initialized, MODE is actually turned on just
after running the major mode's hook. However, MODE is not turned
-on if the hook has explicitly disabled it."
+on if the hook has explicitly disabled it.
+
+\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)"
(declare (doc-string 2))
(let* ((global-mode-name (symbol-name global-mode))
(mode-name (symbol-name mode))
@@ -404,12 +409,12 @@ on if the hook has explicitly disabled it."
keyw)
;; Check keys.
- (while (keywordp (setq keyw (car keys)))
- (setq keys (cdr keys))
+ (while (keywordp (setq keyw (car body)))
+ (pop body)
(pcase keyw
- (:group (setq group (nconc group (list :group (pop keys)))))
- (:global (setq keys (cdr keys)))
- (_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+ (:group (setq group (nconc group (list :group (pop body)))))
+ (:global (pop body))
+ (_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
`(progn
(progn
@@ -446,7 +451,8 @@ See `%s' for more information on %s."
;; Go through existing buffers.
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1))))))
+ (if ,global-mode (funcall #',turn-on) (when ,mode (,mode -1)))))
+ ,@body)
;; Autoloading define-globalized-minor-mode autoloads everything
;; up-to-here.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 16b58632099..2892faae21d 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -207,7 +207,24 @@ expression point is on."
(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
:group 'eldoc
:initialize 'custom-initialize-delay
- :init-value t)
+ :init-value t
+ ;; For `read--expression', the usual global mode mechanism of
+ ;; `change-major-mode-hook' runs in the minibuffer before
+ ;; `eldoc-documentation-function' is set, so `turn-on-eldoc-mode'
+ ;; does nothing. Configure and enable eldoc from
+ ;; `eval-expression-minibuffer-setup-hook' instead.
+ (if global-eldoc-mode
+ (add-hook 'eval-expression-minibuffer-setup-hook
+ #'eldoc--eval-expression-setup)
+ (remove-hook 'eval-expression-minibuffer-setup-hook
+ #'eldoc--eval-expression-setup)))
+
+(defun eldoc--eval-expression-setup ()
+ ;; Setup `eldoc', similar to `emacs-lisp-mode'. FIXME: Call
+ ;; `emacs-lisp-mode' itself?
+ (add-function :before-until (local 'eldoc-documentation-function)
+ #'elisp-eldoc-documentation-function)
+ (eldoc-mode +1))
;;;###autoload
(defun turn-on-eldoc-mode ()
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9fc7e4a797d..142c99edd43 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -285,10 +285,19 @@ Interactively, prompt for LIBRARY using the one at or near point."
A library name is the filename of an Emacs Lisp library located
in a directory under `load-path' (or `find-function-source-path',
if non-nil)."
- (let* ((dirs (or find-function-source-path load-path))
- (suffixes (find-library-suffixes))
- (table (apply-partially 'locate-file-completion-table
- dirs suffixes))
+ (let* ((suffix-regexp (mapconcat
+ (lambda (suffix)
+ (concat (regexp-quote suffix) "\\'"))
+ (find-library-suffixes)
+ "\\|"))
+ (table (cl-loop for dir in (or find-function-source-path load-path)
+ when (file-readable-p dir)
+ append (mapcar
+ (lambda (file)
+ (replace-regexp-in-string suffix-regexp
+ "" file))
+ (directory-files dir nil
+ suffix-regexp))))
(def (if (eq (function-called-at-point) 'require)
;; `function-called-at-point' may return 'require
;; with `point' anywhere on this line. So wrap the
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a72522ad8f8..ef0c5171de6 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1028,6 +1028,7 @@ is wrapped around any parts requiring it."
deps))))
(declare-function lm-header "lisp-mnt" (header))
+(declare-function lm-header-multiline "lisp-mnt" (header))
(declare-function lm-homepage "lisp-mnt" (&optional file))
(declare-function lm-keywords-list "lisp-mnt" (&optional file))
(declare-function lm-maintainer "lisp-mnt" (&optional file))
@@ -1054,8 +1055,7 @@ boundaries."
(narrow-to-region start (point))
(require 'lisp-mnt)
;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
+ (let* (;; Prefer Package-Version; if defined, the package author
;; probably wants us to use it. Otherwise try Version.
(pkg-version
(or (package-strip-rcs-id (lm-header "package-version"))
@@ -1067,9 +1067,9 @@ boundaries."
"Package lacks a \"Version\" or \"Package-Version\" header"))
(package-desc-from-define
file-name pkg-version desc
- (if requires-str
- (package--prepare-dependencies
- (package-read-from-string requires-str)))
+ (and-let* ((require-lines (lm-header-multiline "package-requires")))
+ (package--prepare-dependencies
+ (package-read-from-string (mapconcat #'identity require-lines " "))))
:kind 'single
:url homepage
:keywords keywords
@@ -2894,7 +2894,7 @@ KEYWORDS should be nil or a list of keywords."
(mapcar #'package-menu--print-info-simple info-list))))
(defun package-all-keywords ()
- "Collect all package keywords"
+ "Collect all package keywords."
(let ((key-list))
(package--mapc (lambda (desc)
(setq key-list (append (package-desc--keywords desc)
@@ -2951,7 +2951,7 @@ When none are given, the package matches."
(defun package-menu--generate (remember-pos packages &optional keywords)
"Populate the Package Menu.
- If REMEMBER-POS is non-nil, keep point on the same entry.
+If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display.
@@ -3086,12 +3086,15 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
"`package-archive-contents' before the latest refresh.")
(defun package-menu-refresh ()
- "Download the Emacs Lisp package archive.
-This fetches the contents of each archive specified in
-`package-archives', and then refreshes the package menu."
+ "In Package Menu, download the Emacs Lisp package archive.
+Fetch the contents of each archive specified in
+`package-archives', and then refresh the package menu. Signal a
+user-error if there is already a refresh running asynchronously."
(interactive)
(unless (derived-mode-p 'package-menu-mode)
(user-error "The current buffer is not a Package Menu"))
+ (when (and package-menu-async package--downloads-in-progress)
+ (user-error "Package refresh is already in progress, please wait..."))
(setq package-menu--old-archive-contents package-archive-contents)
(setq package-menu--new-package-list nil)
(package-refresh-contents package-menu-async))
@@ -3206,7 +3209,7 @@ The full list of keys can be viewed with \\[describe-mode]."
"Return the priority of ARCHIVE.
The archive priorities are specified in
-`package-archive-priorities'. If not given there, the priority
+`package-archive-priorities'. If not given there, the priority
defaults to 0."
(or (cdr (assoc archive package-archive-priorities))
0))
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index 47f3b8dc9cf..13cd1c0f42a 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -106,7 +106,7 @@ Usage example:
(setq tchar
(if (and (display-popup-menus-p)
last-input-event ; not during startup
- (listp last-nonmenu-event)
+ (consp last-nonmenu-event)
use-dialog-box)
(x-popup-dialog
t
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index f76409c4de8..bb2bf3dd5fa 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -236,7 +236,9 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(string-trim-left (string-trim-right string trim-right) trim-left))
(defsubst string-blank-p (string)
- "Check whether STRING is either empty or only whitespace."
+ "Check whether STRING is either empty or only whitespace.
+The following characters count as whitespace here: space, tab, newline and
+carriage return."
(string-match-p "\\`[ \t\n\r]*\\'" string))
(defsubst string-remove-prefix (prefix string)
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index d9886d3d67f..c43641aacf3 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -102,16 +102,15 @@ encryption is used."
(apply operation args)))
(defun epa-file-decode-and-insert (string file visit beg end replace)
- (if (fboundp 'decode-coding-inserted-region)
- (save-restriction
- (narrow-to-region (point) (point))
- (insert string)
- (decode-coding-inserted-region
- (point-min) (point-max)
- (substring file 0 (string-match epa-file-name-regexp file))
- visit beg end replace))
- (insert (epa-file--decode-coding-string string (or coding-system-for-read
- 'undecided)))))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (insert string)
+ (decode-coding-inserted-region
+ (point-min) (point-max)
+ (substring file 0 (string-match epa-file-name-regexp file))
+ visit beg end replace)
+ (goto-char (point-max))
+ (- (point-max) (point-min))))
(defvar epa-file-error nil)
(defun epa-file--find-file-not-found-function ()
@@ -147,8 +146,6 @@ encryption is used."
(format "Decrypting %s" file)))
(unwind-protect
(progn
- (if replace
- (goto-char (point-min)))
(condition-case error
(setq string (epg-decrypt-file context local-file nil))
(error
@@ -187,12 +184,11 @@ encryption is used."
;; really edit the buffer.
(let ((buffer-file-name
(if visit nil buffer-file-name)))
- (save-restriction
- (narrow-to-region (point) (point))
- (epa-file-decode-and-insert string file visit beg end replace)
- (setq length (- (point-max) (point-min))))
- (if replace
- (delete-region (point) (point-max))))
+ (setq length
+ (if replace
+ (epa-file--replace-text string file visit beg end)
+ (epa-file-decode-and-insert
+ string file visit beg end replace))))
(if visit
(set-visited-file-modtime))))
(if (and local-copy
@@ -201,6 +197,38 @@ encryption is used."
(list file length)))
(put 'insert-file-contents 'epa-file 'epa-file-insert-file-contents)
+(defun epa-file--replace-text (string file visit beg end)
+ ;; The idea here is that we want to replace the text in the buffer
+ ;; (for instance, for a `revert-buffer'), but we want to touch as
+ ;; little of the text as possible. So we compare the new and the
+ ;; old text and only starts replacing when the text changes.
+ (let ((orig-point (point))
+ new-start length)
+ (goto-char (point-max))
+ (setq new-start (point))
+ (setq length
+ (epa-file-decode-and-insert
+ string file visit beg end t))
+ (if (equal (buffer-substring (point-min) new-start)
+ (buffer-substring new-start (point-max)))
+ ;; The new text is equal to the old, so just keep the old.
+ (delete-region new-start (point-max))
+ ;; Compute the region the hard way.
+ (let ((p1 (point-min))
+ (p2 new-start))
+ (while (and (< p1 new-start)
+ (< p2 (point-max))
+ (eql (char-after p1) (char-after p2)))
+ (cl-incf p1)
+ (cl-incf p2))
+ (delete-region new-start p2)
+ (delete-region p1 new-start)))
+ ;; Restore point, if possible.
+ (if (< orig-point (point-max))
+ (goto-char orig-point)
+ (goto-char (point-max)))
+ length))
+
(defun epa-file-write-region (start end file &optional append visit lockname
mustbenew)
(if append
diff --git a/lisp/epa.el b/lisp/epa.el
index 9e6edf463c6..b55a55fbb9a 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -440,12 +440,12 @@ If ARG is non-nil, mark the key."
(substitute-command-keys "\
- `\\[epa-mark-key]' to mark a key on the line
- `\\[epa-unmark-key]' to unmark a key on the line\n"))
- (widget-create 'link
+ (widget-create 'push-button
:notify (lambda (&rest _ignore) (abort-recursive-edit))
:help-echo
"Click here or \\[abort-recursive-edit] to cancel"
"Cancel")
- (widget-create 'link
+ (widget-create 'push-button
:notify (lambda (&rest _ignore) (exit-recursive-edit))
:help-echo
"Click here or \\[exit-recursive-edit] to finish"
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 55490681698..4a9cc7744cb 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -148,7 +148,11 @@ Otherwise, it tries the programs listed in the entry until the
version requirement is met."
(unless program-alist
(setq program-alist epg-config--program-alist))
- (let ((entry (assq protocol program-alist)))
+ (let ((entry (assq protocol program-alist))
+ ;; In many gnupg distributions (especially on Windows), the
+ ;; version string is "gpg (GnuPG) 2.2.15-unknown" or the like.
+ (version-regexp-alist (cons '("^[-._+ ]?unknown$" . -4)
+ version-regexp-alist)))
(unless entry
(error "Unknown protocol %S" protocol))
(cl-destructuring-bind (symbol . alist)
@@ -262,6 +266,15 @@ a single minimum version string."
(throw 'version-ok t)))
(error "Unsupported version: %s" version))))
+(defun epg-required-version-p (protocol required-version)
+ "Verify a sufficient version of GnuPG for specific protocol.
+PROTOCOL is symbol, either `OpenPGP' or `CMS'. REQUIRED-VERSION
+is a string containing the required version number. Return
+non-nil if that version or higher is installed."
+ (let ((version (cdr (assq 'version (epg-find-configuration protocol)))))
+ (and (stringp version)
+ (version<= required-version version))))
+
;;;###autoload
(defun epg-expand-group (config group)
"Look at CONFIG and try to expand GROUP."
diff --git a/lisp/epg.el b/lisp/epg.el
index ce58c520f17..6d377d07e29 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -1618,7 +1618,9 @@ If you are unsure, use synchronous version of this function
(car (epg-key-sub-key-list signer)))))
(epg-context-signers context)))
(let ((sender (epg-context-sender context)))
- (when (stringp sender)
+ (when (and (eql 'OpenPGP (epg-context-protocol context))
+ (epg-required-version-p 'OpenPGP "2.1.15")
+ (stringp sender))
(list "--sender" sender)))
(epg--args-from-sig-notations
(epg-context-sig-notations context))
@@ -1714,9 +1716,11 @@ If you are unsure, use synchronous version of this function
(car (epg-key-sub-key-list
signer)))))
(epg-context-signers context))))
- (if sign
+ (if (and sign
+ (eql 'OpenPGP (epg-context-protocol context)))
(let ((sender (epg-context-sender context)))
- (when (stringp sender)
+ (when (and (epg-required-version-p 'OpenPGP "2.1.15")
+ (stringp sender))
(list "--sender" sender))))
(if sign
(epg--args-from-sig-notations
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index f5c9decc3a2..fd1bd5545da 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2594,6 +2594,8 @@ every `erc-lurker-cleanup-interval' updates to
consumption of lurker state during long Emacs sessions and/or ERC
sessions with large numbers of incoming PRIVMSGs.")
+(defvar erc-message-parsed)
+
(defun erc-lurker-update-status (_message)
"Update `erc-lurker-state' if necessary.
@@ -2603,18 +2605,20 @@ reflect the fact that its sender has issued a PRIVMSG at the
current time. Otherwise, take no action.
This function depends on the fact that `erc-display-message'
-dynamically binds `parsed', which is used to check if the current
-message is a PRIVMSG and to determine its sender. See also
-`erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
+dynamically binds `erc-message-parsed', which is used to check if
+the current message is a PRIVMSG and to determine its sender.
+See also `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'.
In order to limit memory consumption, this function also calls
`erc-lurker-cleanup' once every `erc-lurker-cleanup-interval'
updates of `erc-lurker-state'."
- (when (and (boundp 'parsed) (erc-response-p parsed))
- (let* ((command (erc-response.command parsed))
+ (when (and (boundp 'erc-message-parsed)
+ (erc-response-p erc-message-parsed))
+ (let* ((command (erc-response.command erc-message-parsed))
(sender
(erc-lurker-maybe-trim
- (car (erc-parse-user (erc-response.sender parsed)))))
+ (car (erc-parse-user
+ (erc-response.sender erc-message-parsed)))))
(server
(erc-canonicalize-server-name erc-server-announced-name)))
(when (equal command "PRIVMSG")
@@ -2704,7 +2708,8 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly.
See also `erc-format-message' and `erc-display-line'."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
- msg)))
+ msg))
+ (erc-message-parsed parsed))
(setq string
(cond
((null type)
diff --git a/lisp/files.el b/lisp/files.el
index f76635017d5..ce4dd99bd53 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1043,7 +1043,7 @@ directory if it does not exist."
(setq errtype "access"))
(with-file-modes ?\700
(condition-case nil
- (make-directory user-emacs-directory)
+ (make-directory user-emacs-directory t)
(error (setq errtype "create")))))
(when (and errtype
user-emacs-directory-warning
@@ -2719,6 +2719,8 @@ since only a single case-insensitive search through the alist is made."
("\\.bib\\'" . bibtex-mode)
("\\.bst\\'" . bibtex-style-mode)
("\\.sql\\'" . sql-mode)
+ ;; These .m4 files are Autoconf files.
+ ("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode)
("\\.m[4c]\\'" . m4-mode)
("\\.mf\\'" . metafont-mode)
("\\.mp\\'" . metapost-mode)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index af8ec68ddd2..04cb087737f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3628,7 +3628,7 @@ possible values."
(unless max-segments
(setq max-segments (length article-time-units)))
(cond
- ((zerop sec)
+ ((< (abs sec) 1)
"Now")
(t
(concat
@@ -5059,7 +5059,10 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(list
(read-file-name "Replace MIME part with file: "
(or mm-default-directory default-directory)
- nil nil)))
+ nil t)))
+ (unless (file-regular-p (file-truename file))
+ (error "Can't replace part with %s, which isn't a regular file"
+ file))
(gnus-mime-save-part-and-strip file))
(defun gnus-mime-save-part-and-strip (&optional file)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 930d522c41b..e8775c66673 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -738,7 +738,6 @@ level. If ARG is nil, Gnus will be started at level 2
and not a positive number, Gnus will prompt the user for the name
of an NNTP server to use. As opposed to \\[gnus], this command
will not connect to the local server."
- (interactive "P")
(let ((val (or arg (1- gnus-level-default-subscribed))))
(gnus val t slave)
(make-local-variable 'gnus-group-use-permanent-levels)
@@ -749,8 +748,6 @@ will not connect to the local server."
If ARG is non-nil and a positive number, Gnus will use that as the
startup level. If ARG is non-nil and not a positive number, Gnus will
prompt the user for the name of an NNTP server to use."
- (interactive "P")
-
(if (gnus-alive-p)
(progn
(gnus-run-hooks 'gnus-before-resume-hook)
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 07d20285343..e0ec829617f 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -915,7 +915,7 @@ If no one is selected, symmetric encryption will be performed. "
(when sign
(setq signers (mml-secure-signers context signer-names))
(setf (epg-context-signers context) signers)
- (when mml-secure-openpgp-sign-with-sender
+ (when (and (eq 'OpenPGP protocol) mml-secure-openpgp-sign-with-sender)
(setf (epg-context-sender context) sender)))
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
@@ -945,10 +945,10 @@ If no one is selected, symmetric encryption will be performed. "
signature micalg)
(when (eq 'OpenPGP protocol)
(setf (epg-context-armor context) t)
- (setf (epg-context-textmode context) t))
+ (setf (epg-context-textmode context) t)
+ (when mml-secure-openpgp-sign-with-sender
+ (setf (epg-context-sender context) sender)))
(setf (epg-context-signers context) signers)
- (when mml-secure-openpgp-sign-with-sender
- (setf (epg-context-sender context) sender))
(when (mml-secure-cache-passphrase-p protocol)
(epg-context-set-passphrase-callback
context
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 65465d3b4c8..b6b0e2a736e 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -447,7 +447,7 @@ highlighting will not update as you type."
(hi-lock-set-pattern
;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
;; or a trailing $ in REGEXP will be interpreted correctly.
- (concat "^.*\\(?:" regexp "\\).*$") face))
+ (concat "^.*\\(?:" regexp "\\).*\\(?:$\\)\n?") face))
;;;###autoload
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 1b69574a392..06a2248d405 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -1846,7 +1846,8 @@ When BUF nil, default to the buffer at current line."
(stringp dired-directory)
dired-directory)))))
(when name
- (string-match regexp name))))))
+ ;; Match on the displayed file name (which is abbreviated).
+ (string-match regexp (abbreviate-file-name name)))))))
;;;###autoload
(defun ibuffer-mark-by-content-regexp (regexp &optional all-buffers)
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 5c30f4085c3..9c7c91eb58a 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -720,11 +720,15 @@ was inserted."
archive-superior-buffer))
(not (and (boundp 'tar-superior-buffer)
tar-superior-buffer))
+ ;; This means the buffer holds the contents
+ ;; of a file uncompressed by jka-compr.el.
+ (not (and (local-variable-p
+ 'jka-compr-really-do-compress)
+ jka-compr-really-do-compress))
;; This means the buffer holds the
;; decrypted content (bug#21870).
- (not (and (boundp 'epa-file-encrypt-to)
- (local-variable-p
- 'epa-file-encrypt-to))))))
+ (not (local-variable-p
+ 'epa-file-encrypt-to)))))
(file-or-data
(if data-p
(let ((str
diff --git a/lisp/info.el b/lisp/info.el
index 16909736f8d..02f3ea580b0 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -318,7 +318,7 @@ want to set `Info-refill-paragraphs'."
(set sym val)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (when (eq major-mode 'Info-mode)
+ (when (derived-mode-p 'Info-mode)
(revert-buffer t t)))))
:group 'info)
@@ -841,7 +841,7 @@ See a list of available Info commands in `Info-mode'."
(defun info-standalone ()
"Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
+In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself."
(setq Info-standalone t)
(if (and command-line-args-left
(not (string-match "^-" (car command-line-args-left))))
@@ -2948,12 +2948,7 @@ N is the digit argument used to invoke this command."
(t
(user-error "No pointer backward from this node")))))
-(defun Info-exit ()
- "Exit Info by selecting some other buffer."
- (interactive)
- (if Info-standalone
- (save-buffers-kill-emacs)
- (quit-window)))
+(define-obsolete-function-alias 'Info-exit #'quit-window "27.1")
(defun Info-next-menu-item ()
"Go to the node of the next menu item."
@@ -4045,7 +4040,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "m" 'Info-menu)
(define-key map "n" 'Info-next)
(define-key map "p" 'Info-prev)
- (define-key map "q" 'Info-exit)
+ (define-key map "q" 'quit-window)
(define-key map "r" 'Info-history-forward)
(define-key map "s" 'Info-search)
(define-key map "S" 'Info-search-case-sensitively)
@@ -4064,6 +4059,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map [follow-link] 'mouse-face)
(define-key map [XF86Back] 'Info-history-back)
(define-key map [XF86Forward] 'Info-history-forward)
+ (define-key map [tool-bar C-Back\ in\ history] 'Info-history-back-menu)
+ (define-key map [tool-bar C-Forward\ in\ history] 'Info-history-forward-menu)
map)
"Keymap containing Info commands.")
@@ -4123,7 +4120,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Copy the name of the current node into the kill ring"]
["Clone Info buffer" clone-buffer
:help "Create a twin copy of the current Info buffer."]
- ["Exit" Info-exit :help "Stop reading Info"]))
+ ["Exit" quit-window :help "Stop reading Info"]))
(defvar info-tool-bar-map
@@ -4152,10 +4149,40 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:label "Index")
(tool-bar-local-item-from-menu 'Info-search "search" map Info-mode-map
:vert-only t)
- (tool-bar-local-item-from-menu 'Info-exit "exit" map Info-mode-map
+ (tool-bar-local-item-from-menu 'quit-window "exit" map Info-mode-map
:vert-only t)
map))
+(defun Info-history-menu (e name history command)
+ (let* ((i (length history))
+ (map (make-sparse-keymap name)))
+ (mapc (lambda (history)
+ (let ((file (nth 0 history))
+ (node (nth 1 history)))
+ (when (stringp file)
+ (setq file (file-name-sans-extension
+ (file-name-nondirectory file))))
+ (define-key map (vector (intern (format "history-%i" i)))
+ `(menu-item ,(format "(%s) %s" file node)
+ (lambda ()
+ (interactive)
+ (dotimes (_ ,i) (call-interactively ',command))))))
+ (setq i (1- i)))
+ (reverse history))
+ (let* ((selection (x-popup-menu e map))
+ (binding (and selection (lookup-key map (vector (car selection))))))
+ (if binding (call-interactively binding)))))
+
+(defun Info-history-back-menu (e)
+ "Pop up the menu with a list of previously visited Info nodes."
+ (interactive "e")
+ (Info-history-menu e "Back in history" Info-history 'Info-history-back))
+
+(defun Info-history-forward-menu (e)
+ "Pop up the menu with a list of Info nodes visited with ‘Info-history-back’."
+ (interactive "e")
+ (Info-history-menu e "Forward in history" Info-history-forward 'Info-history-forward))
+
(defvar Info-menu-last-node nil)
;; Last node the menu was created for.
;; Value is a list, (FILE-NAME NODE-NAME).
@@ -4280,7 +4307,7 @@ topics. Info has commands to follow the references and show you other nodes.
\\<Info-mode-map>\
\\[Info-help] Invoke the Info tutorial.
-\\[Info-exit] Quit Info: reselect previously selected buffer.
+\\[quit-window] Quit Info: reselect previously selected buffer.
Selecting other nodes:
\\[Info-mouse-follow-nearest-node]
@@ -4353,6 +4380,8 @@ Advanced commands:
(add-hook 'clone-buffer-hook 'Info-clone-buffer nil t)
(add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
(add-hook 'isearch-mode-hook 'Info-isearch-start nil t)
+ (when Info-standalone
+ (add-hook 'quit-window-hook 'save-buffers-kill-emacs nil t))
(setq-local isearch-search-fun-function #'Info-isearch-search)
(setq-local isearch-wrap-function #'Info-isearch-wrap)
(setq-local isearch-push-state-function #'Info-isearch-push-state)
@@ -5303,7 +5332,7 @@ completion alternatives to currently visited manuals."
found)
(dolist (buffer blist)
(with-current-buffer buffer
- (when (and (eq major-mode 'Info-mode)
+ (when (and (derived-mode-p 'Info-mode)
(stringp Info-current-file)
(string-match manual-re Info-current-file))
(setq found buffer
@@ -5318,7 +5347,7 @@ completion alternatives to currently visited manuals."
(let (names)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (and (eq major-mode 'Info-mode)
+ (and (derived-mode-p 'Info-mode)
(stringp Info-current-file)
(not (string= (substring (buffer-name) 0 1) " "))
(push (file-name-sans-extension
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index f42b594dc46..e91175fb832 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -1329,7 +1329,8 @@ If STR has `advice' text property, append the following special event:
(defvar quail-conversion-str nil)
(defun quail-input-method (key)
- (if (or (and buffer-read-only
+ (if (or (and (or buffer-read-only
+ (get-char-property (point) 'read-only))
(not (or inhibit-read-only
(get-char-property (point) 'inhibit-read-only))))
(and overriding-terminal-local-map
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index e925adbb110..7bac452a5ce 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -59,58 +59,6 @@ should return a grid vector array that is the new solution.
;;;***
-;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-mode.el
-(push (purecopy '(ada-mode 4 0)) package--builtin-versions)
-
-(autoload 'ada-add-extensions "ada-mode" "\
-Define SPEC and BODY as being valid extensions for Ada files.
-Going from body to spec with `ff-find-other-file' used these
-extensions.
-SPEC and BODY are two regular expressions that must match against
-the file name.
-
-\(fn SPEC BODY)" nil nil)
-
-(autoload 'ada-mode "ada-mode" "\
-Ada mode is the major mode for editing Ada code.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-mode" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-prj" "progmodes/ada-prj.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-prj.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-prj" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-stmt.el
-
-(autoload 'ada-header "ada-stmt" "\
-Insert a descriptive header at the top of the file." t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-stmt" '("ada-")))
-
-;;;***
-
-;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (0 0 0 0))
-;;; Generated autoloads from progmodes/ada-xref.el
-
-(autoload 'ada-find-file "ada-xref" "\
-Open FILENAME, from anywhere in the source path.
-Completion is available.
-
-\(fn FILENAME)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ada-xref" '("ada-")))
-
-;;;***
-
;;;### (autoloads nil "add-log" "vc/add-log.el" (0 0 0 0))
;;; Generated autoloads from vc/add-log.el
@@ -1273,7 +1221,7 @@ Entering array mode calls the function `array-mode-hook'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward" "xor")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "array" '("array-" "current-line" "limit-index" "move-to-column-untabify" "untabify-backward")))
;;;***
@@ -2490,7 +2438,9 @@ If the value is not a function it should be a list of pairs
\(REGEXP . FUNCTION). In this case the function called will be the one
associated with the first REGEXP which matches the current URL. The
function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.")
+regexp should probably be \".\" to specify a default browser.
+
+Also see `browse-url-secondary-browser-function'.")
(custom-autoload 'browse-url-browser-function "browse-url" t)
@@ -3026,8 +2976,15 @@ it won't work in an interactive Emacs." nil nil)
Run `byte-compile-file' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
-Each file is processed even if an error occurred previously.
+
+Each file is processed even if an error occurred previously. If
+a file name denotes a directory, all Emacs Lisp source files in
+that directory (that have previously been compiled) will be
+recompiled if newer than the compiled files. In this case,
+NOFORCE is ignored.
+
For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
+
If NOFORCE is non-nil, don't recompile a file that seems to be
already up-to-date.
@@ -4763,13 +4720,6 @@ and runs the normal hook `command-history-hook'." t nil)
;;;***
-;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (0 0 0 0))
-;;; Generated autoloads from emacs-lisp/cl.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl" '("cl-" "define-" "defsetf" "flet" "labels" "lexical-let")))
-
-;;;***
-
;;;### (autoloads "actual autoloads are elsewhere" "cl-extra" "emacs-lisp/cl-extra.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-extra.el
@@ -5250,9 +5200,8 @@ Otherwise, it saves all modified buffers without asking.")
(defvar compilation-search-path '(nil) "\
List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of
-directories. The value nil as an element means the error
-message buffer `default-directory'.")
+Elements should be directory names, not file names of directories.
+The value nil as an element means to try the default directory.")
(custom-autoload 'compilation-search-path "compile" t)
@@ -5385,7 +5334,7 @@ This is the value of `next-error-function' in Compilation buffers.
\(fn N &optional RESET)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "recompile")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "compile" '("compil" "define-compilation-mode" "kill-compilation" "overlay-arrow-overlay" "recompile")))
;;;***
@@ -8112,14 +8061,17 @@ For example, you could write
Make a global mode GLOBAL-MODE corresponding to buffer-local minor MODE.
TURN-ON is a function that will be called with no args in every buffer
and that should try to turn MODE on if applicable for that buffer.
-KEYS is a list of CL-style keyword arguments. As the minor mode
- defined by this function is always global, any :global keyword is
- ignored. Other keywords have the same meaning as in `define-minor-mode',
- which see. In particular, :group specifies the custom group.
- The most useful keywords are those that are passed on to the
- `defcustom'. It normally makes no sense to pass the :lighter
- or :keymap keywords to `define-globalized-minor-mode', since these
- are usually passed to the buffer-local version of the minor mode.
+Each of KEY VALUE is a pair of CL-style keyword arguments. As
+ the minor mode defined by this function is always global, any
+ :global keyword is ignored. Other keywords have the same
+ meaning as in `define-minor-mode', which see. In particular,
+ :group specifies the custom group. The most useful keywords
+ are those that are passed on to the `defcustom'. It normally
+ makes no sense to pass the :lighter or :keymap keywords to
+ `define-globalized-minor-mode', since these are usually passed
+ to the buffer-local version of the minor mode.
+BODY contains code to execute each time the mode is enabled or disabled.
+ It is executed after toggling the mode, and before running GLOBAL-MODE-hook.
If MODE's set-up depends on the major mode in effect when it was
enabled, then disabling and reenabling MODE should make MODE work
@@ -8131,7 +8083,7 @@ When a major mode is initialized, MODE is actually turned on just
after running the major mode's hook. However, MODE is not turned
on if the hook has explicitly disabled it.
-\(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t)
+\(fn GLOBAL-MODE MODE TURN-ON [KEY VALUE]... BODY...)" nil t)
(function-put 'define-globalized-minor-mode 'doc-string-elt '2)
@@ -8207,6 +8159,17 @@ pairs:
if the expression evaluates to a non-nil value. `:enable' is
an alias for `:active'.
+ :label FORM
+ FORM is an expression that is dynamically evaluated and whose
+ value serves as the menu's label (the default is the first
+ element of MENU).
+
+ :help HELP
+ HELP is a string, the help to display for the menu.
+ In a GUI this is a \"tooltip\" on the menu button. (Though
+ in Lucid :help is not shown for the top-level menu bar, only
+ for sub-menus.)
+
The rest of the elements in MENU are menu items.
A menu item can be a vector of three elements:
@@ -12855,7 +12818,11 @@ to get the effect of a C-q.
\(fn &optional BUFFER)" nil nil)
(autoload 'fill-flowed "flow-fill" "\
+Apply RFC2646 decoding to BUFFER.
+If BUFFER is nil, default to the current buffer.
+If DELETE-SPACE, delete RFC2646 spaces padding at the end of
+lines.
\(fn &optional BUFFER DELETE-SPACE)" nil nil)
@@ -14762,24 +14729,6 @@ Add the window configuration CONF to `gnus-buffer-configuration'.
;;;### (autoloads nil "gnutls" "net/gnutls.el" (0 0 0 0))
;;; Generated autoloads from net/gnutls.el
-(defvar gnutls-min-prime-bits 256 "\
-Minimum number of prime bits accepted by GnuTLS for key exchange.
-During a Diffie-Hellman handshake, if the server sends a prime
-number with fewer than this number of bits, the handshake is
-rejected. (The smaller the prime number, the less secure the
-key exchange is against man-in-the-middle attacks.)
-
-A value of nil says to use the default GnuTLS value.
-
-The default value of this variable is such that virtually any
-connection can be established, whether this connection can be
-considered cryptographically \"safe\" or not. However, Emacs
-network security is handled at a higher level via
-`open-network-stream' and the Network Security Manager. See Info
-node `(emacs) Network Security'.")
-
-(custom-autoload 'gnutls-min-prime-bits "gnutls" t)
-
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "gnutls" '("gnutls-" "open-gnutls-stream")))
;;;***
@@ -14863,11 +14812,11 @@ if ARG is `toggle'; disable the mode otherwise.
(autoload 'gravatar-retrieve "gravatar" "\
Asynchronously retrieve a gravatar for MAIL-ADDRESS.
-When finished, call CB as (apply CB GRAVATAR CBARGS),
+When finished, call CALLBACK as (apply CALLBACK GRAVATAR CBARGS),
where GRAVATAR is either an image descriptor, or the symbol
`error' if the retrieval failed.
-\(fn MAIL-ADDRESS CB &optional CBARGS)" nil nil)
+\(fn MAIL-ADDRESS CALLBACK &optional CBARGS)" nil nil)
(autoload 'gravatar-retrieve-synchronously "gravatar" "\
Synchronously retrieve a gravatar for MAIL-ADDRESS.
@@ -15107,9 +15056,15 @@ and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
(autoload 'pdb "gud" "\
-Run pdb on program FILE in buffer `*gud-FILE*'.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger.
+Run COMMAND-LINE in the `*gud-FILE*' buffer.
+
+COMMAND-LINE should include the pdb executable
+name (`gud-pdb-command-name') and the file to be debugged.
+
+If called interactively, the command line will be prompted for.
+
+The directory containing this file becomes the initial working
+directory and source-file directory for your debugger.
\(fn COMMAND-LINE)" t nil)
@@ -17117,7 +17072,8 @@ RET Select the file at the front of the list of matches.
\\[ido-toggle-case] Toggle case-sensitive searching of file names.
\\[ido-toggle-literal] Toggle literal reading of this file.
\\[ido-completion-help] Show list of matching files in separate window.
-\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'." t nil)
+\\[ido-toggle-ignore] Toggle ignoring files listed in `ido-ignore-files'.
+\\[ido-reread-directory] Reread the current directory." t nil)
(autoload 'ido-find-file-other-window "ido" "\
Switch to another file and show it in another window.
@@ -17965,7 +17921,7 @@ Display the \"Reporting Bugs\" section of the Emacs manual in Info mode." t nil)
(autoload 'info-standalone "info" "\
Run Emacs as a standalone Info reader.
Usage: emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself." nil nil)
+In standalone mode, \\<Info-mode-map>\\[quit-window] exits Emacs itself." nil nil)
(autoload 'Info-on-current-buffer "info" "\
Use Info mode to browse the current Info buffer.
@@ -18007,7 +17963,7 @@ one topic and contains references to other nodes which discuss related
topics. Info has commands to follow the references and show you other nodes.
\\<Info-mode-map>\\[Info-help] Invoke the Info tutorial.
-\\[Info-exit] Quit Info: reselect previously selected buffer.
+\\[quit-window] Quit Info: reselect previously selected buffer.
Selecting other nodes:
\\[Info-mouse-follow-nearest-node]
@@ -20528,10 +20484,9 @@ OTHER-HEADERS is an alist specifying additional header fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
-CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
-RETURN-ACTION and any additional arguments are IGNORED.
+Any additional arguments are IGNORED.
-\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil)
+\(fn &optional TO SUBJECT OTHER-HEADERS &rest IGNORED)" nil nil)
(autoload 'mh-send-letter "mh-comp" "\
Save draft and send message.
@@ -21787,8 +21742,38 @@ Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `nslookup-program' for looking up the DNS information.
+See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
+non-interactive versions of this function more suitable for use
+in Lisp code.
+
\(fn HOST &optional NAME-SERVER)" t nil)
+(autoload 'nslookup-host-ipv4 "net-utils" "\
+Return the IPv4 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 4-integer
+vector of octets.
+
+This command uses `nslookup-program' to look up DNS records.
+
+\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
+
+(autoload 'nslookup-host-ipv6 "net-utils" "\
+Return the IPv6 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 8-integer
+vector of hextets.
+
+This command uses `nslookup-program' to look up DNS records.
+
+\(fn HOST &optional NAME-SERVER FORMAT)" nil nil)
+
(autoload 'nslookup "net-utils" "\
Run `nslookup-program'." t nil)
@@ -21845,7 +21830,7 @@ Open a network connection to HOST on PORT.
\(fn HOST PORT)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "ipconfig" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "net-utils" '("arp-program" "dig-program" "dns-lookup-program" "finger-X.500-host-regexps" "ftp-" "ifconfig-program" "iwconfig-program" "net" "nslookup-" "ping-program" "route-program" "run-network-program" "smbclient" "traceroute-program" "whois-")))
;;;***
@@ -24268,7 +24253,7 @@ matching parenthesis is highlighted in `show-paren-style' after
(put 'parse-time-rules 'risky-local-variable t)
(autoload 'parse-time-string "parse-time" "\
-Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
+Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
somewhat liberal in what format it accepts, and will attempt to
@@ -33258,7 +33243,7 @@ If DATE lacks timezone information, GMT is assumed.
(defalias 'time-to-seconds 'float-time)
-(defalias 'seconds-to-time 'encode-time)
+(defalias 'seconds-to-time 'time-convert)
(autoload 'days-to-time "time-date" "\
Convert DAYS into a time value.
@@ -36411,7 +36396,7 @@ Usage:
Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
vhdl-mode\") in a directory with an existing project setup file, it is
automatically loaded and its project activated if option
- `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
+ `vhdl-project-autoload' is non-nil. Names/paths of the project setup
files can be specified in option `vhdl-project-file-name'. Multiple
project setups can be automatically loaded from global directories.
This is an alternative to specifying project setups with option
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index e802c2408f7..8491181bbe1 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -517,7 +517,8 @@ If the \"..\" directory entry has nil attributes, the attributes
are copied from the \".\" entry, if they are non-nil. Otherwise,
the offending element is removed from the list, as are any
elements for other directory entries with nil attributes."
- (if (and (null (cdr (assoc ".." file-alist)))
+ (if (and (consp (assoc ".." file-alist))
+ (null (cdr (assoc ".." file-alist)))
(cdr (assoc "." file-alist)))
(setcdr (assoc ".." file-alist) (cdr (assoc "." file-alist))))
(rassq-delete-all nil file-alist))
diff --git a/lisp/macros.el b/lisp/macros.el
index 4b38506d8a5..3470359c0ca 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -38,13 +38,13 @@
(defun macros--insert-vector-macro (definition)
"Print DEFINITION, a vector, into the current buffer."
- (dotimes (i (length definition))
- (let ((char (aref definition i)))
- (insert (if (zerop i) ?\[ ?\s))
- (if (characterp char)
- (princ (prin1-char char) (current-buffer))
- (prin1 char (current-buffer)))))
- (insert ?\]))
+ (insert ?\[
+ (mapconcat (lambda (event)
+ (or (prin1-char event)
+ (prin1-to-string event)))
+ definition
+ " ")
+ ?\]))
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 7b50fcd96e0..4dbd4d7b086 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -33,8 +33,7 @@
;; paragraph and we let `fill-region' fill the long line into several
;; lines with the quote prefix as `fill-prefix'.
-;; Todo: implement basic `fill-region' (Emacs and XEmacs
-;; implementations differ..)
+;; Todo: implement basic `fill-region'
;;; History:
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 3151dae0aa2..87a8248854f 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -781,7 +781,9 @@ as ARGS."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
- (when (and url-handler-mode (not (file-name-absolute-p url)))
+ (when (and url-handler-mode
+ (not (file-name-absolute-p url))
+ (not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
(function (or (and (string-match "\\`mailto:" url)
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 61480f35877..da7665089ec 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -113,16 +113,14 @@ Security'."
"/etc/ssl/cert.pem" ; macOS
)
"List of CA bundle location filenames or a function returning said list.
+If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
-;;;###autoload
-(defcustom gnutls-min-prime-bits 256
- ;; Several mail servers send fewer bits than the GnuTLS default.
- ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
+(defcustom gnutls-min-prime-bits nil
"Minimum number of prime bits accepted by GnuTLS for key exchange.
During a Diffie-Hellman handshake, if the server sends a prime
number with fewer than this number of bits, the handshake is
@@ -138,9 +136,22 @@ network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
- (integer :tag "Number of bits" 512))
+ (integer :tag "Number of bits" 2048))
:group 'gnutls)
+(defcustom gnutls-crlfiles
+ '(
+ "/etc/grid-security/certificates/*.crl.pem"
+ )
+ "List of CRL file paths or a function returning said list.
+If a file path contains glob wildcards, they will be expanded.
+The files may be in PEM or DER format, as per the GnuTLS documentation.
+The files may not exist, in which case they will be ignored."
+ :group 'gnutls
+ :type '(choice (function :tag "Function to produce list of CRL filenames")
+ (repeat (file :tag "CRL filename")))
+ :version "27.1")
+
(defun open-gnutls-stream (name buffer host service &optional parameters)
"Open a SSL/TLS connection for a service to a host.
Returns a subprocess-object to represent the connection.
@@ -304,6 +315,7 @@ here's a recent version of the list.
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
+ (crlfiles (or crlfiles (gnutls-crlfiles)))
(maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
":%DUMBFW"
""))
@@ -345,13 +357,18 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:verify-error ,verify-error
:callbacks nil)))
+(defun gnutls--get-files (files)
+ (cl-loop for f in files
+ if f do (setq f (if (functionp f) (funcall f) f))
+ append (cl-delete-if-not #'file-exists-p (file-expand-wildcards f t))))
+
(defun gnutls-trustfiles ()
"Return a list of usable trustfiles."
- (delq nil
- (mapcar (lambda (f) (and f (file-exists-p f) f))
- (if (functionp gnutls-trustfiles)
- (funcall gnutls-trustfiles)
- gnutls-trustfiles))))
+ (gnutls--get-files gnutls-trustfiles))
+
+(defun gnutls-crlfiles ()
+ "Return a list of usable CRL files."
+ (gnutls--get-files gnutls-crlfiles))
(declare-function gnutls-error-string "gnutls.c" (error))
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index dcc7e01b6b4..4f68e5db61d 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -43,6 +43,10 @@
;; still use them for queries). Actually the trend these
;; days is for /sbin to be a symlink to /usr/sbin, but we still need to
;; search both for older systems.
+
+(require 'subr-x)
+(require 'cl-lib)
+
(defun net-utils--executable-find-sbin (command)
"Return absolute name of COMMAND if found in an sbin directory."
(let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
@@ -514,7 +518,11 @@ Optional argument NAME-SERVER says which server to use for
DNS resolution.
Interactively, prompt for NAME-SERVER if invoked with prefix argument.
-This command uses `nslookup-program' for looking up the DNS information."
+This command uses `nslookup-program' for looking up the DNS information.
+
+See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
+non-interactive versions of this function more suitable for use
+in Lisp code."
(interactive
(list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
@@ -531,6 +539,71 @@ This command uses `nslookup-program' for looking up the DNS information."
options)))
;;;###autoload
+(defun nslookup-host-ipv4 (host &optional name-server format)
+ "Return the IPv4 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 4-integer
+vector of octets.
+
+This command uses `nslookup-program' to look up DNS records."
+ (let* ((args `(,nslookup-program "-type=A" ,host ,name-server))
+ (output (shell-command-to-string
+ (string-join (cl-remove nil args) " ")))
+ (ip (or (and (string-match
+ "Name:.*\nAddress: *\\(\\([0-9]\\{1,3\\}\\.?\\)\\{4\\}\\)"
+ output)
+ (match-string 1 output))
+ host)))
+ (cond ((memq format '(string nil))
+ ip)
+ ((eq format 'vector)
+ (apply #'vector (mapcar #'string-to-number (split-string ip "\\."))))
+ (t (error "Invalid format: %s" format)))))
+
+(defun ipv6-expand (ipv6-vector)
+ (let ((len (length ipv6-vector)))
+ (if (< len 8)
+ (let* ((pivot (cl-position 0 ipv6-vector))
+ (head (cl-subseq ipv6-vector 0 pivot))
+ (tail (cl-subseq ipv6-vector (1+ pivot) len)))
+ (vconcat head (make-vector (- 8 (1- len)) 0) tail))
+ ipv6-vector)))
+
+;;;###autoload
+(defun nslookup-host-ipv6 (host &optional name-server format)
+ "Return the IPv6 address for HOST (name or IP address).
+Optional argument NAME-SERVER says which server to use for DNS
+resolution.
+
+If FORMAT is `string', returns the IP address as a
+string (default). If FORMAT is `vector', returns a 8-integer
+vector of hextets.
+
+This command uses `nslookup-program' to look up DNS records."
+ (let* ((args `(,nslookup-program "-type=AAAA" ,host ,name-server))
+ (output (shell-command-to-string
+ (string-join (cl-remove nil args) " ")))
+ (hextet "[0-9a-fA-F]\\{1,4\\}")
+ (ip-regex (concat "\\(\\(" hextet "[:]\\)\\{1,6\\}\\([:]?\\(" hextet "\\)\\{1,6\\}\\)\\)"))
+ (ip (or (and (string-match
+ (if (eq system-type 'windows-nt)
+ (concat "Name:.*\nAddress: *" ip-regex)
+ (concat "has AAAA address " ip-regex))
+ output)
+ (match-string 1 output))
+ host)))
+ (cond ((memq format '(string nil))
+ ip)
+ ((eq format 'vector)
+ (ipv6-expand (apply #'vector
+ (cl-loop for hextet in (split-string ip "[:]")
+ collect (string-to-number hextet 16)))))
+ (t (error "Invalid format: %s" format)))))
+
+;;;###autoload
(defun nslookup ()
"Run `nslookup-program'."
(interactive)
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index dbfa2101f0c..11535a5a5a1 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -26,7 +26,9 @@
(require 'cl-lib)
(require 'rmc) ; read-multiple-choice
-(eval-when-compile (require 'subr-x))
+(require 'subr-x)
+(require 'seq)
+(require 'map)
(defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil)
@@ -44,26 +46,43 @@ connection should be handled.
The following values are possible:
-`low': Absolutely no checks are performed.
-`medium': This is the default level, should be reasonable for most usage.
-`high': This warns about additional things that many people would
-not find useful.
+`low': No checks are performed: This is extremely insecure.
+`medium': Default. Suitable for most circumstances.
+`high': Warns about additional issues not enabled in `medium' due to
+compatibility concerns.
`paranoid': On this level, the user is queried for most new connections.
See the Emacs manual for a description of all things that are
checked and warned against."
:version "25.1"
- :group 'nsm
:type '(choice (const :tag "Low" low)
- (const :tag "Medium" medium)
- (const :tag "High" high)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)
(const :tag "Paranoid" paranoid)))
+(defcustom nsm-trust-local-network nil
+ "Disable warnings when visiting trusted hosts on local networks.
+
+The default suite of TLS checks in NSM is designed to follow the
+most current security best practices. Under some situations,
+such as attempting to connect to an email server that do not
+follow these practices inside a school or corporate network, NSM
+may produce warnings for such occasions. Setting this option to
+a non-nil value, or a zero-argument function that returns non-nil
+tells NSM to skip checking for potential TLS vulnerabilities when
+connecting to hosts on a local network.
+
+Make sure you know what you are doing before enabling this
+option."
+ :version "27.1"
+ :type '(choice (const :tag "On" t)
+ (const :tag "Off" nil)
+ (function :tag "Custom function")))
+
(defcustom nsm-settings-file (expand-file-name "network-security.data"
user-emacs-directory)
"The file the security manager settings will be stored in."
:version "25.1"
- :group 'nsm
:type 'file)
(defcustom nsm-save-host-names nil
@@ -71,7 +90,6 @@ checked and warned against."
By default, only hosts that have exceptions have their names
stored in plain text."
:version "25.1"
- :group 'nsm
:type 'boolean)
(defvar nsm-noninteractive nil
@@ -98,241 +116,673 @@ to keep track of the TLS status of STARTTLS servers.
If WARN-UNENCRYPTED, query the user if the connection is
unencrypted."
- (if (eq network-security-level 'low)
- process
- (let* ((status (gnutls-peer-status process))
- (id (nsm-id host port))
- (settings (nsm-host-settings id)))
- (cond
- ((not (process-live-p process))
- nil)
- ((not status)
- ;; This is a non-TLS connection.
- (nsm-check-plain-connection process host port settings
- warn-unencrypted))
- (t
- (let ((process
- (nsm-check-tls-connection process host port status settings)))
- (when (and process save-fingerprint
- (null (nsm-host-settings id)))
- (nsm-save-host host port status 'fingerprint 'always))
- process))))))
+ (let* ((status (gnutls-peer-status process))
+ (id (nsm-id host port))
+ (settings (nsm-host-settings id)))
+ (cond
+ ((not (process-live-p process))
+ nil)
+ ((not status)
+ ;; This is a non-TLS connection.
+ (nsm-check-plain-connection process host port settings
+ warn-unencrypted))
+ (t
+ (let ((process
+ (nsm-check-tls-connection process host port status settings)))
+ (when (and process save-fingerprint
+ (null (nsm-host-settings id)))
+ (nsm-save-host host port status 'fingerprint nil 'always))
+ process)))))
+
+(defcustom network-security-protocol-checks
+ '(;; Old Known Weaknesses.
+ (version medium)
+ (compression medium)
+ (renegotiation-info-ext medium)
+ (verify-cert medium)
+ (same-cert medium)
+ (null-suite medium)
+ (export-kx medium)
+ (anon-kx medium)
+ (md5-sig medium)
+ (rc4-cipher medium)
+ ;; Weaknesses made known after 2013.
+ (dhe-prime-kx medium)
+ (sha1-sig medium)
+ (ecdsa-cbc-cipher medium)
+ ;; Towards TLS 1.3
+ (dhe-kx high)
+ (rsa-kx high)
+ (3des-cipher high)
+ (cbc-cipher high))
+ "This variable specifies what TLS connection checks to perform.
+It's an alist where the key is the name of the check, and the
+value is the minimum security level the check should begin.
+
+Each check function is called with the parameters HOST PORT
+STATUS SETTINGS. HOST is the host domain, PORT is a TCP port
+number, STATUS is the peer status returned by
+`gnutls-peer-status', and SETTINGS is the persistent and session
+settings for the host HOST. Please refer to the contents of
+`nsm-setting-file' for details. If a problem is found, the check
+function is required to return an error message, and nil
+otherwise.
+
+See also: `nsm-check-tls-connection', `nsm-save-host-names',
+`nsm-settings-file'"
+ :version "27.1"
+ :type '(repeat (list (symbol :tag "Check function")
+ (choice :tag "Level"
+ :value medium
+ (const :tag "Low" low)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)))))
+
+(defun nsm-save-fingerprint-maybe (host port status &rest _)
+ "Saves the certificate's fingerprint.
+
+In order to detect man-in-the-middle attacks, when
+`network-security-level' is `high', this function will save the
+fingerprint of the certificate for check functions to check."
+ (when (>= (nsm-level network-security-level) (nsm-level 'high))
+ ;; Save the host fingerprint so that we can check it the
+ ;; next time we connect.
+ (nsm-save-host host port status 'fingerprint nil 'always)))
+
+(defvar nsm-tls-post-check-functions '(nsm-save-fingerprint-maybe)
+ "Functions to run after checking a TLS session.
+
+Each function will be run with the parameters HOST PORT STATUS
+SETTINGS and RESULTS. The parameters HOST PORT STATUS and
+SETTINGS are the same as those supplied to each check function.
+RESULTS is an alist where the keys are the checks run and the
+values the results of the checks.")
+
+(defun nsm-network-same-subnet (local-ip mask ip)
+ "Returns t if IP is in the same subnet as LOCAL-IP/MASK.
+LOCAL-IP, MASK, and IP are specified as vectors of integers, and
+are expected to have the same length. Works for both IPv4 and
+IPv6 addresses."
+ (let ((matches t)
+ (length (length local-ip)))
+ (unless (memq length '(4 5 8 9))
+ (error "Unexpected length of IP address %S" local-ip))
+ (dotimes (i length)
+ (setq matches (and matches
+ (=
+ (logand (aref local-ip i)
+ (aref mask i))
+ (logand (aref ip i)
+ (aref mask i))))))
+ matches))
+
+(defun nsm-should-check (host)
+ "Determines whether NSM should check for TLS problems for HOST.
+
+If `nsm-trust-local-network' is or returns non-nil, and if the
+host address is a localhost address, or in the same subnet as one
+of the local interfaces, this function returns nil. Non-nil
+otherwise."
+ (let ((addresses (network-lookup-address-info host))
+ (network-interface-list (network-interface-list))
+ (off-net t))
+ (when
+ (or (and (functionp nsm-trust-local-network)
+ (funcall nsm-trust-local-network))
+ nsm-trust-local-network)
+ (mapc
+ (lambda (address)
+ (mapc
+ (lambda (iface)
+ (let ((info (network-interface-info (car iface))))
+ (when
+ (nsm-network-same-subnet (substring (car info) 0 -1)
+ (substring (car (cddr info)) 0 -1)
+ address)
+ (setq off-net nil))))
+ network-interface-list))
+ addresses))
+ off-net))
(defun nsm-check-tls-connection (process host port status settings)
- (when-let ((process
- (nsm-check-certificate process host port status settings)))
- ;; Do further protocol-level checks.
- (nsm-check-protocol process host port status settings)))
+ "Check TLS connection against potential security problems.
+
+This function runs each test defined in
+`network-security-protocol-checks' in the order specified against
+the TLS connection's peer status STATUS for the host HOST and
+port PORT.
+
+If one or more problems are found, this function will collect all
+the error messages returned by the check functions, and confirm
+with the user in interactive mode whether to continue with the
+TLS session.
+
+If the user declines to continue, or problem(s) are found under
+non-interactive mode, the process PROCESS will be deleted, thus
+terminating the connection.
+
+This function returns the process PROCESS if no problems are
+found, and nil otherwise.
+
+See also: `network-security-protocol-checks' and `nsm-noninteractive'"
+ (when (nsm-should-check host)
+ (let* ((results
+ (cl-loop
+ for check in network-security-protocol-checks
+ for type = (intern (format ":%s" (car check)) obarray)
+ ;; Skip the check if the user has already said that this
+ ;; host is OK for this type of "error".
+ for result = (and (not (memq type
+ (plist-get settings :conditions)))
+ (>= (nsm-level network-security-level)
+ (nsm-level (cadr check)))
+ (funcall
+ (intern (format "nsm-protocol-check--%s"
+ (car check))
+ obarray)
+ host port status settings))
+ when result
+ collect (cons type result)))
+ (problems (nconc (plist-get status :warnings) (map-keys results))))
+
+ ;; We haven't seen this before, and we're paranoid.
+ (when (and (eq network-security-level 'paranoid)
+ (not (nsm-fingerprint-ok-p status settings)))
+ (push '(:not-seen . "Certificate not seen before") results))
+
+ (when (and results
+ (not (seq-set-equal-p (plist-get settings :conditions)
+ problems))
+ (not (nsm-query host port status
+ 'conditions
+ problems
+ (format-message
+ "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s"
+ host port
+ (if (> (length problems) 1)
+ "s" "")
+ (concat "* " (string-join
+ (split-string
+ (string-join
+ (map-values results)
+ "\n")
+ "\n")
+ "\n* ")))))
+ (delete-process process)
+ (setq process nil)))
+ (run-hook-with-args 'nsm-tls-post-check-functions
+ host port status settings results)))
+ process)
+
+
+
+;; Certificate checks
(declare-function gnutls-peer-status-warning-describe "gnutls.c"
- (status-symbol))
+ (status-symbol))
+
+(defun nsm-protocol-check--verify-cert (host port status settings)
+ "Check for warnings from the certificate verification status.
-(defun nsm-check-certificate (process host port status settings)
+This is the most basic security check for a TLS connection. If
+ certificate verification fails, it means the server's identity
+ cannot be verified by the credentials received."
(let ((warnings (plist-get status :warnings)))
- (cond
+ (and warnings
+ (not (nsm-warnings-ok-p status settings))
+ (mapconcat #'gnutls-peer-status-warning-describe warnings "\n"))))
- ;; The certificate validated, but perhaps we want to do
- ;; certificate pinning.
- ((null warnings)
- (cond
- ((< (nsm-level network-security-level) (nsm-level 'high))
- process)
- ;; The certificate is fine, but if we're paranoid, we might
- ;; want to check whether it's changed anyway.
- ((and (>= (nsm-level network-security-level) (nsm-level 'high))
- (not (nsm-fingerprint-ok-p host port status settings)))
- (delete-process process)
- nil)
- ;; We haven't seen this before, and we're paranoid.
- ((and (eq network-security-level 'paranoid)
- (null settings)
- (not (nsm-new-fingerprint-ok-p host port status)))
- (delete-process process)
- nil)
- (t
- process)))
-
- ;; The certificate did not validate.
- ((not (equal network-security-level 'low))
- ;; We always want to pin the certificate of invalid connections
- ;; to track man-in-the-middle or the like.
- (if (not (nsm-fingerprint-ok-p host port status settings))
- (progn
- (delete-process process)
- nil)
- ;; We have a warning, so query the user.
- (if (and (not (nsm-warnings-ok-p status settings))
- (not (nsm-query
- host port status 'conditions
- "The TLS connection to %s:%s is insecure for the following reason%s:\n\n%s"
- host port
- (if (> (length warnings) 1)
- "s" "")
- (mapconcat #'gnutls-peer-status-warning-describe
- warnings
- "\n"))))
- (progn
- (delete-process process)
- nil)
- process))))))
-
-(defvar network-security-protocol-checks
- '((diffie-hellman-prime-bits medium 1024)
- (rc4 medium)
- (signature-sha1 medium)
- (intermediate-sha1 medium)
- (3des high)
- (ssl medium))
- "This variable specifies what TLS connection checks to perform.
-It's an alist where the first element is the name of the check,
-the second is the security level where the check kicks in, and the
-optional third element is a parameter supplied to the check.
-
-An element like `(rc4 medium)' will result in the function
-`nsm-protocol-check--rc4' being called with the parameters
-HOST PORT STATUS OPTIONAL-PARAMETER.")
-
-(defun nsm-check-protocol (process host port status settings)
- (cl-loop for check in network-security-protocol-checks
- for type = (intern (format ":%s" (car check)) obarray)
- while process
- ;; Skip the check if the user has already said that this
- ;; host is OK for this type of "error".
- when (and (not (memq type (plist-get settings :conditions)))
- (>= (nsm-level network-security-level)
- (nsm-level (cadr check))))
- do (let ((result
- (funcall (intern (format "nsm-protocol-check--%s"
- (car check))
- obarray)
- host port status (nth 2 check))))
- (unless result
- (delete-process process)
- (setq process nil))))
- ;; If a test failed we return nil, otherwise the process object.
- process)
+(defun nsm-protocol-check--same-cert (host port status settings)
+ "Check for certificate fingerprint mismatch.
-(defun nsm--encryption (status)
- (format "%s-%s-%s"
- (plist-get status :key-exchange)
- (plist-get status :cipher)
- (plist-get status :mac)))
+If the fingerprints saved do not match the fingerprint of the
+certificate presented, the TLS session may be under a
+man-in-the-middle attack."
+ (and (not (nsm-fingerprint-ok-p status settings))
+ (format-message
+ "fingerprint has changed")))
+
+;; Key exchange checks
+
+(defun nsm-protocol-check--rsa-kx (host port status &optional settings)
+ "Check for static RSA key exchange.
+
+Static RSA key exchange methods do not offer perfect forward
+secrecy, therefore, the security of a TLS session is only as
+secure as the server's private key. Due to TLS' use of RSA key
+exchange to create a session key (the key negotiated between the
+client and the server to encrypt traffic), if the server's
+private key had been compromised, the attacker will be able to
+decrypt any past TLS session recorded, as opposed to just one TLS
+session if the key exchange was conducted via a key exchange
+method that offers perfect forward secrecy, such as ephemeral
+Diffie-Hellman key exchange.
-(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits)
+By default, this check is only enabled when
+`network-security-level' is set to `high' for compatibility
+reasons.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", \"(4.1. General Guidelines)\"
+`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "^\\bRSA\\b" kx)
+ (format-message
+ "RSA key exchange method (%s) does not offer perfect forward secrecy"
+ kx))))
+
+(defun nsm-protocol-check--dhe-prime-kx (host port status &optional settings)
+ "Check for the key strength of DH key exchange based on integer factorization.
+
+This check is a response to Logjam[1]. Logjam is an attack that
+allows an attacker with sufficient resource, and positioned
+between the user and the server, to downgrade vulnerable TLS
+connections to insecure 512-bit export grade crypotography.
+
+The Logjam paper suggests using 1024-bit prime on the client to
+mitigate some effects of this attack, and upgrade to 2048-bit as
+soon as server configurations allow. According to SSLLabs' SSL
+Pulse tracker, only about 75% of server support 2048-bit key
+exchange in June 2018[2]. To provide a balance between
+compatibility and security, this function only checks for a
+minimum key strength of 1024-bit.
+
+See also: `nsm-protocol-check--dhe-kx'
+
+Reference:
+
+[1]: Adrian et al (2014). \"Imperfect Forward Secrecy: How
+Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
+[2]: SSL Pulse (June 03, 2018). \"Key Exchange Strength\",
+`https://www.ssllabs.com/ssl-pulse/'"
(let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
- (or (not prime-bits)
- (>= prime-bits bits)
- (nsm-query
- host port status :diffie-hellman-prime-bits
- "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s is less than what is considered safe (%s)."
- prime-bits host port bits))))
-
-(defun nsm-protocol-check--3des (host port status _)
- (or (not (string-match "\\b3DES\\b" (plist-get status :cipher)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the 3DES cipher (%s), which is believed to be unsafe."
- host port (plist-get status :cipher))))
-
-(defun nsm-protocol-check--rc4 (host port status _)
- (or (not (string-match "\\bRC4\\b" (nsm--encryption status)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the RC4 algorithm (%s), which is believed to be unsafe."
- host port (nsm--encryption status))))
-
-(defun nsm-protocol-check--signature-sha1 (host port status _)
- (let ((signature-algorithm
- (plist-get (plist-get status :certificate) :signature-algorithm)))
- (or (not (string-match "\\bSHA1\\b" signature-algorithm))
- (nsm-query
- host port status :signature-sha1
- "The certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
- host port signature-algorithm))))
-
-(defun nsm-protocol-check--intermediate-sha1 (host port status _)
- ;; Skip the first certificate, because that's the host certificate.
- (cl-loop for certificate in (cdr (plist-get status :certificates))
+ (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
+ (< prime-bits 1024))
+ (format-message
+ "Diffie-Hellman key strength (%s bits) too weak (%s bits)"
+ prime-bits 1024))))
+
+(defun nsm-protocol-check--dhe-kx (host port status &optional settings)
+ "Check for existence of DH key exchange based on integer factorization.
+
+In the years since the discovery of Logjam, it was discovered
+that there were rampant use of small subgroup prime or composite
+number for DHE by many servers, and thus allowed themselves to be
+vulnerable to backdoors[1]. Given the difficulty in validating
+Diffie-Hellman parameters, major browser vendors had started to
+remove DHE since 2016[2]. Emacs stops short of banning DHE and
+terminating connection, but prompts the user instead.
+
+References:
+
+[1]: Dorey, Fong, and Essex (2016). \"Indiscreet Logs: Persistent
+Diffie-Hellman Backdoors in TLS.\",
+`https://eprint.iacr.org/2016/999.pdf'
+[2]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\",
+`https://www.chromestatus.com/feature/5128908798164992'"
+ (let ((kx (plist-get status :key-exchange)))
+ (when (string-match "^\\bDHE\\b" kx)
+ (format-message
+ "unable to verify Diffie-Hellman key exchange method (%s) parameters"
+ kx))))
+
+(defun nsm-protocol-check--export-kx (host port status &optional settings)
+ "Check for RSA-EXPORT key exchange.
+
+EXPORT cipher suites are a family of 40-bit and 56-bit effective
+security algorithms legally exportable by the United States in
+the early 90s[1]. They can be broken in seconds on 2018 hardware.
+
+Prior to 3.2.0, GnuTLS had only supported RSA-EXPORT key
+exchange. Since 3.2.0, RSA-EXPORT had been removed, therefore,
+this check has no effect on GnuTLS >= 3.2.0.
+
+Reference:
+
+[1]: Schneier, Bruce (1996). Applied Cryptography (Second ed.). John
+Wiley & Sons. ISBN 0-471-11709-9.
+[2]: N. Mavrogiannopoulos, FSF (Apr 2015). \"GnuTLS NEWS -- History
+of user-visible changes.\" Version 3.4.0,
+`https://gitlab.com/gnutls/gnutls/blob/master/NEWS'"
+ (when (< libgnutls-version 30200)
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bEXPORT\\b" kx)
+ (format-message
+ "EXPORT level key exchange (%s) is insecure"
+ kx)))))
+
+(defun nsm-protocol-check--anon-kx (host port status &optional settings)
+ "Check for anonymous key exchange.
+
+Anonymous key exchange exposes the connection to
+man-in-the-middle attacks.
+
+Reference:
+
+GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
+authentication\",
+`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bANON\\b" kx)
+ (format-message
+ "anonymous key exchange method (%s) can be unsafe"
+ kx))))
+
+;; Cipher checks
+
+(defun nsm-protocol-check--cbc-cipher (host port status &optional settings)
+ "Check for CBC mode ciphers.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has
+been enabled by default[3]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+Reference:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[3]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-protocol-check--ecdsa-cbc-cipher (host port status &optional settings)
+ "Check for CBC mode cipher usage under ECDSA key exchange.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Due to current widespread use of CBC mode ciphers by servers,
+this function only checks for CBC mode cipher usage in
+combination with ECDSA key exchange, which is virtually
+non-existent[2].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[3] has
+been enabled by default[4]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+References:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: Chrome Platform Status (2017). \"Remove CBC-mode ECDSA ciphers in
+TLS\", `https://www.chromestatus.com/feature/5740978103123968'
+[3]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[4]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((kx (plist-get status :key-exchange))
+ (cipher (plist-get status :cipher)))
+ (and (string-match "\\bECDSA\\b" kx)
+ (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-protocol-check--3des-cipher (host port status &optional settings)
+ "Check for 3DES ciphers.
+
+Due to its use of 64-bit block size, it is known that a
+ciphertext collision is highly likely when 2^32 blocks are
+encrypted with the same key bundle under 3-key 3DES. Practical
+birthday attacks of this kind have been demostrated by Sweet32[1].
+As such, NIST is in the process of disallowing its use in TLS[2].
+
+[1]: Bhargavan, Leurent (2016). \"On the Practical (In-)Security of
+64-bit Block Ciphers — Collision Attacks on HTTP over TLS and
+OpenVPN\", `https://sweet32.info/'
+[2]: NIST Information Technology Laboratory (Jul 2017). \"Update to
+Current Use and Deprecation of TDEA\",
+`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\b3DES\\b" cipher)
+ (format-message
+ "3DES cipher (%s) is weak"
+ cipher))))
+
+(defun nsm-protocol-check--rc4-cipher (host port status &optional settings)
+ "Check for RC4 ciphers.
+
+RC4 cipher has been prohibited by RFC 7465[1].
+
+Since GnuTLS 3.4.0, RC4 is not enabled by default[2], but can be
+enabled if requested. This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+[1]: Popov A (Feb 2015). \"Prohibiting RC4 Cipher Suites\",
+`https://tools.ietf.org/html/rfc7465'
+[2]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bARCFOUR\\b" cipher)
+ (format-message
+ "RC4 cipher (%s) is insecure"
+ cipher))))
+
+;; Signature checks
+
+(defun nsm-protocol-check--sha1-sig (host port status &optional settings)
+ "Check for SHA1 signatures on certificates.
+
+The first SHA1 collision was found in 2017[1], as a precaution
+against the events following the discovery of cheap collisions in
+MD5, major browsers[2][3][4][5] have removed the use of SHA1
+signatures in certificates.
+
+References:
+
+[1]: Stevens M, Karpman P et al (2017). \"The first collision for
+full SHA-1\", `https://shattered.io/static/shattered.pdf'
+[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
+Features (SHA-1 Certificate Signatures)\",
+`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
+`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
+[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
+avoid connection failures\",
+`https://support.apple.com/en-gb/HT207459'
+[5]: Microsoft Security Advisory 4010323 (2017). \"Deprecation of
+SHA-1 for SSL/TLS Certificates in Microsoft Edge and Internet Explorer
+11\",
+`https://docs.microsoft.com/en-us/security-updates/securityadvisories/2017/4010323'"
+ (cl-loop for certificate in (plist-get status :certificates)
+ for algo = (plist-get certificate :signature-algorithm)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bSHA1\\b" algo))
+ return (format-message
+ "SHA1 signature (%s) is prone to collisions"
+ algo)
+ end))
+
+(defun nsm-protocol-check--md5-sig (host port status &optional settings)
+ "Check for MD5 signatures on certificates.
+
+In 2008, a group of researchers were able to forge an
+intermediate CA certificate that appeared to be legitimate when
+checked by MD5[1]. RFC 6151[2] has recommended against the usage
+of MD5 for digital signatures, which includes TLS certificate
+signatures.
+
+Since GnuTLS 3.3.0, MD5 has been disabled by default, but can be
+enabled if requested.
+
+References:
+
+[1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today
+- Creating a rogue CA certificate\",
+`http://www.win.tue.nl/hashclash/rogue-ca/'
+[2]: Turner S, Chen L (2011). \"Updated Security Considerations for
+the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
+`https://tools.ietf.org/html/rfc6151'"
+ (cl-loop for certificate in (plist-get status :certificates)
for algo = (plist-get certificate :signature-algorithm)
- ;; Don't check root certificates -- SHA1 isn't dangerous
- ;; there.
- when (and (not (equal (plist-get certificate :issuer)
- (plist-get certificate :subject)))
- (string-match "\\bSHA1\\b" algo)
- (not (nsm-query
- host port status :intermediate-sha1
- "An intermediate certificate used to verify the connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be unsafe."
- host port algo)))
- do (cl-return nil)
- finally (cl-return t)))
-
-(defun nsm-protocol-check--ssl (host port status _)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bMD5\\b" algo))
+ return (format-message
+ "MD5 signature (%s) is very prone to collisions"
+ algo)
+ end))
+
+;; Extension checks
+
+(defun nsm-protocol-check--renegotiation-info-ext (host port status
+ &optional settings)
+ "Check for renegotiation_info TLS extension status.
+
+If this TLS extension is not used, the connection established is
+vulnerable to an attack in which an impersonator can extract
+sensitive information such as HTTP session ID cookies or login
+passwords. Renegotiation was removed in TLS1.3, so this is only
+checked for earlier protocol versions.
+
+Reference:
+
+E. Rescorla, M. Ray, S. Dispensa, N. Oskov (Feb 2010). \"Transport
+Layer Security (TLS) Renegotiation Indication Extension\",
+`https://tools.ietf.org/html/rfc5746'"
+ (when (plist-member status :safe-renegotiation)
+ (let ((unsafe-renegotiation (not (plist-get status :safe-renegotiation))))
+ (and unsafe-renegotiation
+ (format-message
+ "safe renegotiation is not supported, connection not protected from impersonators")))))
+
+;; Compression checks
+
+(defun nsm-protocol-check--compression (host port status &optional settings)
+ "Check for TLS compression.
+
+TLS compression attacks such as CRIME would allow an attacker to
+decrypt ciphertext. As a result, RFC 7525 has recommended its
+disablement.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'"
+ (let ((compression (plist-get status :compression)))
+ (and compression
+ (string-match "^\\bDEFLATE\\b" compression)
+ (format-message
+ "compression method (%s) may lead to leakage of sensitive information"
+ compression))))
+
+;; Protocol version checks
+
+(defun nsm-protocol-check--version (host port status &optional settings)
+ "Check for SSL/TLS protocol version.
+
+This function guards against the usage of SSL3.0, which has been
+deprecated by RFC7568[1], and TLS 1.0, which has been deprecated
+by PCI DSS[2].
+
+References:
+
+[1]: Barnes, Thomson, Pironti, Langley (2015). \"Deprecating Secure
+Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568'
+[2]: PCI Security Standards Council (2016). \"Migrating from SSL and
+Early TLS\"
+`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'"
(let ((protocol (plist-get status :protocol)))
- (or (not protocol)
- (not (string-match "SSL" protocol))
- (nsm-query
- host port status :ssl
- "The connection to %s:%s uses the %s protocol, which is believed to be unsafe."
- host port protocol))))
+ (and protocol
+ (or (string-match "SSL" protocol)
+ (and (string-match "TLS1.\\([0-9]+\\)" protocol)
+ (< (string-to-number (match-string 1 protocol)) 1)))
+ (format-message
+ "%s protocol is deprecated by standard bodies"
+ protocol))))
+
+;; Full suite checks
+
+(defun nsm-protocol-check--null-suite (host port status &optional settings)
+ "Check for NULL cipher suites.
+
+This function checks for NULL key exchange, cipher and message
+authentication code key derivation function. As the name
+suggests, a NULL assigned for any of the above disables an
+integral part of the security properties that makes up the TLS
+protocol."
+ (let ((suite (nsm-cipher-suite status)))
+ (and (string-match "\\bNULL\\b" suite)
+ (format-message
+ "NULL cipher suite (%s) violates authenticity, integrity, or confidentiality guarantees"
+ suite))))
+
+
(defun nsm-fingerprint (status)
(plist-get (plist-get status :certificate) :public-key-id))
-(defun nsm-fingerprint-ok-p (host port status settings)
- (let ((did-query nil))
- (if (and settings
- (not (eq (plist-get settings :fingerprint) :none))
- (not (equal (nsm-fingerprint status)
- (plist-get settings :fingerprint)))
- (not
- (setq did-query
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s has changed from %s to %s"
- host port
- (plist-get settings :fingerprint)
- (nsm-fingerprint status)))))
- ;; Not OK.
- nil
- (when did-query
- ;; Remove any exceptions that have been set on the previous
- ;; certificate.
- (plist-put settings :conditions nil))
- t)))
-
-(defun nsm-new-fingerprint-ok-p (host port status)
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s is new: %s"
- host port
- (nsm-fingerprint status)))
+(defun nsm-fingerprint-ok-p (status settings)
+ (let ((saved-fingerprints (plist-get settings :fingerprints)))
+ ;; Haven't seen this host before or not pinning cert.
+ (or (null saved-fingerprints)
+ ;; Plain connection allowed.
+ (memq :none saved-fingerprints)
+ ;; We are pinning certs, and we have seen this host before,
+ ;; but the credientials for this host differs from the last
+ ;; times we saw it.
+ (member (nsm-fingerprint status) saved-fingerprints))))
(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
- ;; If this connection used to be TLS, but is now plain, then it's
- ;; possible that we're being Man-In-The-Middled by a proxy that's
- ;; stripping out STARTTLS announcements.
- (cond
- ((and (plist-get settings :fingerprint)
- (not (eq (plist-get settings :fingerprint) :none))
- (not
- (nsm-query
- host port nil 'conditions
- "The connection to %s:%s used to be an encrypted connection, but is now unencrypted. This might mean that there's a man-in-the-middle tapping this connection."
- host port)))
- (delete-process process)
- nil)
- ((and warn-unencrypted
- (not (memq :unencrypted (plist-get settings :conditions)))
- (not (nsm-query
- host port nil 'conditions
- "The connection to %s:%s is unencrypted."
- host port)))
- (delete-process process)
- nil)
- (t
- process)))
-
-(defun nsm-query (host port status what message &rest args)
+ (if (nsm-should-check host)
+ ;; If this connection used to be TLS, but is now plain, then it's
+ ;; possible that we're being Man-In-The-Middled by a proxy that's
+ ;; stripping out STARTTLS announcements.
+ (let ((fingerprints (plist-get settings :fingerprints)))
+ (cond
+ ((and fingerprints
+ (not (memq :none fingerprints))
+ (not
+ (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s used to be an encrypted connection, but is now unencrypted. This might mean that there's a man-in-the-middle tapping this connection."
+ host port))))
+ (delete-process process)
+ nil)
+ ((and warn-unencrypted
+ (not (memq :unencrypted (plist-get settings :conditions)))
+ (not (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s is unencrypted."
+ host port))))
+ (delete-process process)
+ nil)
+ (t
+ process)))
+ process))
+
+(defun nsm-query (host port status what problems message)
;; If there is no user to answer queries, then say `no' to everything.
(if (or noninteractive
nsm-noninteractive)
@@ -340,9 +790,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(let ((response
(condition-case nil
(intern
- (car (split-string
- (nsm-query-user message args
- (nsm-format-certificate status))))
+ (car (split-string (nsm-query-user message status)))
obarray)
;; Make sure we manage to close the process if the user hits
;; `C-g'.
@@ -356,46 +804,111 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
"Accepting certificate for %s:%s this session only"
"Permanently accepting certificate for %s:%s")
host port)
- (nsm-save-host host port status what response)
- t))))
-
-(defun nsm-query-user (message args cert)
- (catch 'return
- (while t
- (let ((buffer (get-buffer-create "*Network Security Manager*")))
- (save-window-excursion
- ;; First format the certificate and warnings.
- (with-help-window buffer
- (with-current-buffer buffer
- (erase-buffer)
- (when (> (length cert) 0)
- (insert cert "\n"))
- (let ((start (point)))
- (insert (apply #'format-message message args))
- (goto-char start)
- ;; Fill the first line of the message, which usually
- ;; contains lots of explanatory text.
- (fill-region (point) (line-end-position)))))
- ;; Then ask the user what to do about it.
- (pcase (unwind-protect
- (cadr
- (read-multiple-choice
- "Continue connecting?"
- '((?a "always" "Accept this certificate this session and for all future sessions.")
- (?s "session only" "Accept this certificate this session only.")
- (?n "no" "Refuse to use this certificate, and close the connection.")
- (?r "reshow" "Reshow certificate information."))))
- (kill-buffer buffer))
- ("reshow")
- (val (throw 'return val))))))))
-
-(defun nsm-save-host (host port status what permanency)
+ (nsm-save-host host port status what problems response)
+ t))))
+
+(set-advertised-calling-convention
+ 'nsm-query '(host port status what problems message) "27.1")
+
+(declare-function gnutls-format-certificate "gnutls.c" (cert))
+
+(defun nsm-query-user (message status)
+ (let ((buffer (get-buffer-create "*Network Security Manager*"))
+ (cert-buffer (get-buffer-create "*Certificate Details*"))
+ (certs (plist-get status :certificates)))
+ (save-window-excursion
+ ;; First format the certificate and warnings.
+ (with-current-buffer-window
+ buffer nil nil
+ (when status (insert (nsm-format-certificate status)))
+ (insert message)
+ (goto-char (point-min))
+ ;; Fill the first line of the message, which usually
+ ;; contains lots of explanatory text.
+ (fill-region (point) (line-end-position)))
+ ;; Then ask the user what to do about it.
+ (unwind-protect
+ (let* ((accept-choices '((?a "always" "Accept this certificate this session and for all future sessions.")
+ (?s "session only" "Accept this certificate this session only.")
+ (?n "no" "Refuse to use this certificate, and close the connection.")
+ (?d "details" "See certificate details")))
+ (details-choices '((?b "backward page" "See previous page")
+ (?f "forward page" "See next page")
+ (?n "next" "Next certificate")
+ (?p "previous" "Previous certificate")
+ (?q "quit" "Quit details view")))
+ (answer (read-multiple-choice "Continue connecting?"
+ accept-choices))
+ (show-details (char-equal (car answer) ?d))
+ (pems (cl-loop for cert in certs
+ collect (gnutls-format-certificate
+ (plist-get cert :pem))))
+ (cert-index 0))
+ (while show-details
+ (unless (get-buffer-window cert-buffer)
+ (set-window-buffer (get-buffer-window buffer) cert-buffer)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))
+
+ (setq answer (read-multiple-choice "Viewing certificate:" details-choices))
+
+ (cond
+ ((char-equal (car answer) ?q)
+ (setq show-details (not show-details))
+ (set-window-buffer (get-buffer-window cert-buffer) buffer)
+ (setq show-details (char-equal
+ (car (setq answer
+ (read-multiple-choice
+ "Continue connecting?"
+ accept-choices)))
+ ?d)))
+
+ ((char-equal (car answer) ?b)
+ (with-selected-window (get-buffer-window cert-buffer)
+ (with-current-buffer cert-buffer
+ (ignore-errors (scroll-down)))))
+
+ ((char-equal (car answer) ?f)
+ (with-selected-window (get-buffer-window cert-buffer)
+ (with-current-buffer cert-buffer
+ (ignore-errors (scroll-up)))))
+
+ ((char-equal (car answer) ?n)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (setq cert-index (mod (1+ cert-index) (length pems)))
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))
+
+ ((char-equal (car answer) ?p)
+ (with-current-buffer cert-buffer
+ (read-only-mode -1)
+ (erase-buffer)
+ (setq cert-index (mod (1- cert-index) (length pems)))
+ (insert (nth cert-index pems))
+ (goto-char (point-min))
+ (read-only-mode)))))
+ (cadr answer))
+ (kill-buffer cert-buffer)
+ (kill-buffer buffer)))))
+
+(set-advertised-calling-convention 'nsm-query-user '(message status) "27.1")
+
+(defun nsm-save-host (host port status what problems permanency)
(let* ((id (nsm-id host port))
- (saved
- (list :id id
- :fingerprint (or (nsm-fingerprint status)
- ;; Plain connection.
- :none))))
+ (saved-fingerprints (plist-get (nsm-host-settings id) :fingerprints))
+ (fingerprints (cl-delete-duplicates
+ (append saved-fingerprints
+ (list (or (nsm-fingerprint status)
+ ;; Plain connection.
+ :none)))
+ :test #'string=))
+ (saved (list :id id :fingerprints fingerprints)))
(when (or (eq what 'conditions)
nsm-save-host-names)
(nconc saved (list :host (format "%s:%s" host port))))
@@ -403,20 +916,19 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
;; of the certificate/unencrypted connection.
(cond
((eq what 'conditions)
- (cond
- ((not status)
- (nconc saved '(:conditions (:unencrypted))))
- ((plist-get status :warnings)
- (nconc saved
- (list :conditions (plist-get status :warnings))))))
- ((not (eq what 'fingerprint))
+ (plist-put saved :conditions problems))
+ ;; Make sure the conditions are not erased when we save a
+ ;; fingerprint
+ ((eq what 'fingerprint)
;; Store additional protocol settings.
(let ((settings (nsm-host-settings id)))
- (when settings
- (setq saved settings))
- (if (plist-get saved :conditions)
- (nconc (plist-get saved :conditions) (list what))
- (nconc saved (list :conditions (list what)))))))
+ (when settings
+ (setq saved settings))
+ (if (plist-get saved :conditions)
+ (plist-put saved :conditions
+ (cl-delete-duplicates
+ (nconc (plist-get saved :conditions) problems)))
+ (plist-put saved :conditions problems)))))
(if (eq permanency 'always)
(progn
(nsm-remove-temporary-setting id)
@@ -426,6 +938,11 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(nsm-remove-temporary-setting id)
(push saved nsm-temporary-host-settings))))
+(set-advertised-calling-convention
+ 'nsm-save-host
+ '(host port status what problems permanency)
+ "27.1")
+
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
(insert "(\n")
@@ -483,44 +1000,58 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(let ((cert (plist-get status :certificate)))
(when cert
(with-temp-buffer
- (insert
- "Certificate information\n"
- "Issued by:"
- (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
- "Issued to:"
+ (insert
+ (propertize "Certificate information" 'face 'underline) "\n"
+ " Issued by:"
+ (nsm-certificate-part (plist-get cert :issuer) "CN" t) "\n"
+ " Issued to:"
(or (nsm-certificate-part (plist-get cert :subject) "O")
(nsm-certificate-part (plist-get cert :subject) "OU" t))
- "\n"
- "Hostname:"
+ "\n"
+ " Hostname:"
(nsm-certificate-part (plist-get cert :subject) "CN" t) "\n")
(when (and (plist-get cert :public-key-algorithm)
(plist-get cert :signature-algorithm))
(insert
- "Public key:" (plist-get cert :public-key-algorithm)
+ " Public key:" (plist-get cert :public-key-algorithm)
", signature: " (plist-get cert :signature-algorithm) "\n"))
- (when (and (plist-get status :key-exchange)
+ (when (and (plist-get status :key-exchange)
(plist-get status :cipher)
(plist-get status :mac)
(plist-get status :protocol))
(insert
- "Protocol:" (plist-get status :protocol)
+ " Session:" (plist-get status :protocol)
", key: " (plist-get status :key-exchange)
", cipher: " (plist-get status :cipher)
", mac: " (plist-get status :mac) "\n"))
- (when (plist-get cert :certificate-security-level)
+ (when (plist-get cert :certificate-security-level)
(insert
- "Security level:"
+ " Security level:"
(propertize (plist-get cert :certificate-security-level)
'face 'bold)
"\n"))
(insert
- "Valid:From " (plist-get cert :valid-from)
- " to " (plist-get cert :valid-to) "\n\n")
- (goto-char (point-min))
+ " Valid:From " (plist-get cert :valid-from)
+ " to " (plist-get cert :valid-to) "\n")
+ (insert "\n")
+ (goto-char (point-min))
(while (re-search-forward "^[^:]+:" nil t)
- (insert (make-string (- 20 (current-column)) ? )))
+ (insert (make-string (- 22 (current-column)) ? )))
(buffer-string)))))
+(defun nsm-level (symbol)
+ "Return a numerical level for SYMBOL for easier comparison."
+ (cond
+ ((eq symbol 'low) 0)
+ ((eq symbol 'medium) 1)
+ (t 2)))
+
+(defun nsm-cipher-suite (status)
+ (format "%s-%s-%s"
+ (plist-get status :key-exchange)
+ (plist-get status :cipher)
+ (plist-get status :mac)))
+
(defun nsm-certificate-part (string part &optional full)
(let ((part (cadr (assoc part (nsm-parse-subject string)))))
(cond
@@ -552,13 +1083,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
elem)))
(nreverse result)))))
-(defun nsm-level (symbol)
- "Return a numerical level for SYMBOL for easier comparison."
- (cond
- ((eq symbol 'low) 0)
- ((eq symbol 'medium) 1)
- ((eq symbol 'high) 2)
- (t 3)))
+(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
(provide 'nsm)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index fbd1a9b7661..81c3fb4aa52 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -715,10 +715,15 @@ size, and full-buffer size."
;; Success; continue.
(when (= (preceding-char) ?\s)
(delete-char -1))
- (let ((gap-start (point)))
- (insert "\n")
+ (let ((gap-start (point))
+ (face (get-text-property (point) 'face)))
+ ;; Extend the background to the end of the line.
+ (if face
+ (insert (propertize "\n" 'face (shr-face-background face)))
+ (insert "\n"))
(shr-indent)
(when (and (> (1- gap-start) (point-min))
+ (get-text-property (point) 'shr-url)
;; The link on both sides of the newline are the
;; same...
(equal (get-text-property (point) 'shr-url)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f1f0abc6e5c..bcfac78ee65 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -719,7 +719,7 @@ for($i = 0; $i < $n; $i++)
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) . \"\\\"\";
$filename =~ s/\"/\\\\\"/g;
printf(
- \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u) (%%u . %%u))\\n\",
+ \"(\\\"%%s\\\" %%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
$filename,
$type,
$stat[3],
@@ -733,10 +733,7 @@ for($i = 0; $i < $n; $i++)
$stat[10] & 0xffff,
$stat[7],
$stat[2],
- $stat[1] >> 16 & 0xffff,
- $stat[1] & 0xffff,
- $stat[0] >> 16 & 0xffff,
- $stat[0] & 0xffff);
+ $stat[1]);
}
printf(\")\\n\");' \"$1\" \"$2\" 2>/dev/null"
"Perl script implementing `directory-files-attributes' as Lisp `read'able
@@ -1762,11 +1759,14 @@ of."
;; We must care about file names with spaces, or starting with
;; "-"; this would confuse xargs. "ls -aQ" might be a
;; solution, but it does not work on all remote systems.
+ ;; Therefore, we use \000 as file separator.
+ ;; `tramp-sh--quoting-style-options' do not work for file names
+ ;; with spaces piped to "xargs".
;; Apostrophes in the stat output are masked as
;; `tramp-stat-marker', in order to make a proper shell escape
;; of them in file names.
- "cd %s && echo \"(\"; (%s %s -a | "
- "xargs %s -c "
+ "cd %s && echo \"(\"; (%s %s -a | tr '\\n\\r' '\\000\\000' | "
+ "xargs -0 %s -c "
"'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
"-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\""))
(tramp-shell-quote-argument localname)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index d419f9d87d0..ed0f1def181 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4211,9 +4211,10 @@ the remote host use line-endings as defined in the variable
(tramp-message vec 5 "Sentinel called: `%S' `%s'" proc event)
(tramp-flush-connection-properties proc)
(tramp-flush-directory-properties vec ""))
- (goto-char (point-max))
- (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
- (delete-region (point) (point-max))))))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-max))
+ (when (and prompt (re-search-backward (regexp-quote prompt) nil t))
+ (delete-region (point) (point-max)))))))
(defun tramp-get-inode (vec)
"Returns the virtual inode number.
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 2d19c145b0a..be09a73a1f1 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -562,7 +562,8 @@ FILE is created there."
(gamegrid-shared-game-dir
(not (zerop (logand #o6000 (or update-game-score-modes 0))))))
(cond ((or (not update-game-score-modes) (file-name-absolute-p file))
- (gamegrid-add-score-insecure file score))
+ (gamegrid-add-score-insecure file score
+ gamegrid-user-score-file-directory))
((and gamegrid-shared-game-dir
(file-exists-p (expand-file-name file shared-game-score-directory)))
;; Use the setgid (or setuid) "update-game-score" program
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4cc1daf4fa6..f0b34c702ca 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,9 +701,8 @@ of `my-compilation-root' here."
;;;###autoload
(defcustom compilation-search-path '(nil)
"List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of
-directories. The value nil as an element means the error
-message buffer `default-directory'."
+Elements should be directory names, not file names of directories.
+The value nil as an element means to try the default directory."
:type '(repeat (choice (const :tag "Default" nil)
(string :tag "Directory"))))
@@ -2575,28 +2574,94 @@ region and the first line of the next region."
(defcustom compilation-context-lines nil
"Display this many lines of leading context before the current message.
-If nil and the left fringe is displayed, don't scroll the
+If nil or t, and the left fringe is displayed, don't scroll the
compilation output window; an arrow in the left fringe points to
-the current message. If nil and there is no left fringe, the message
-displays at the top of the window; there is no arrow."
- :type '(choice integer (const :tag "No window scrolling" nil))
+the current message. With no left fringe, If nil, the message
+scrolls to the top of the window; there is no arrow. If t, don't
+scroll the compilation output window at all; an arrow before
+column zero points to the current message."
+ :type '(choice integer
+ (const :tag "Scroll window when no fringe" nil)
+ (const :tag "No window scrolling" t))
:version "22.1")
(defsubst compilation-set-window (w mk)
- "Align the compilation output window W with marker MK near top."
- (if (integerp compilation-context-lines)
- (set-window-start w (save-excursion
- (goto-char mk)
- (compilation-beginning-of-line
- (- 1 compilation-context-lines))
- (point)))
+ "Maybe align the compilation output window W with marker MK near top."
+ (cond ((integerp compilation-context-lines)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (compilation-beginning-of-line
+ (- 1 compilation-context-lines))
+ (point))))
+ ((eq compilation-context-lines t))
;; If there is no left fringe.
- (when (equal (car (window-fringes w)) 0)
- (set-window-start w (save-excursion
- (goto-char mk)
- (beginning-of-line 1)
- (point)))))
- (set-window-point w mk))
+ ((equal (car (window-fringes w)) 0)
+ (set-window-start w (save-excursion
+ (goto-char mk)
+ (beginning-of-line 1)
+ (point)))
+ (set-window-point w mk))
+ (t (set-window-point w mk))))
+
+(defvar-local compilation-arrow-overlay nil
+ "Overlay with the before-string property of `overlay-arrow-string'.
+
+When non-nil, this overlay causes redisplay to display `overlay-arrow-string'
+at the overlay's start position.")
+
+(defconst compilation--margin-string (propertize "=>" 'face 'default)
+ "The string which will appear in the margin in compilation mode.")
+
+(defconst compilation--dummy-string
+ (propertize ">" 'display
+ `((margin left-margin) ,compilation--margin-string))
+ "A string which is only a placeholder for `compilation--margin-string'.
+Actual value is never used, only the text property.")
+
+(defun compilation-set-up-arrow-spec-in-margin ()
+ "Set up compilation-arrow-overlay to display as an arrow in a margin."
+ (setq overlay-arrow-string "")
+ (setq compilation-arrow-overlay
+ (make-overlay overlay-arrow-position overlay-arrow-position))
+ (overlay-put compilation-arrow-overlay
+ 'before-string compilation--dummy-string)
+ (set-window-margins (selected-window) (+ (or (car (window-margins)) 0) 2)))
+
+(defun compilation-tear-down-arrow-spec-in-margin ()
+ "Restore compilation-arrow-overlay to not using the margin, which is removed."
+ (overlay-put compilation-arrow-overlay 'before-string nil)
+ (delete-overlay compilation-arrow-overlay)
+ (setq compilation-arrow-overlay nil)
+ (set-window-margins (selected-window) (- (car (window-margins)) 2)))
+
+(defun compilation-set-overlay-arrow (w)
+ "Set up, or switch off, the overlay-arrow for window W."
+ (with-selected-window w ; So the later `goto-char' will work.
+ (if (and (eq compilation-context-lines t)
+ (equal (car (window-fringes w)) 0)) ; No left fringe
+ ;; Insert a before-string overlay at the beginning of the line
+ ;; pointed to by `overlay-arrow-position', such that it will
+ ;; display in a 2-character margin.
+ (progn
+ (cond
+ ((overlayp compilation-arrow-overlay)
+ (when (not (eq (overlay-start compilation-arrow-overlay)
+ overlay-arrow-position))
+ (if overlay-arrow-position
+ (move-overlay compilation-arrow-overlay
+ overlay-arrow-position overlay-arrow-position)
+ (compilation-tear-down-arrow-spec-in-margin))))
+
+ (overlay-arrow-position
+ (compilation-set-up-arrow-spec-in-margin)))
+ ;; Ensure that the "=>" remains in the window by causing
+ ;; the window to be scrolled, if needed.
+ (goto-char (overlay-start compilation-arrow-overlay)))
+
+ ;; `compilation-context-lines' isn't t, or we've got a left
+ ;; fringe, so remove any overlay arrow.
+ (when (overlayp compilation-arrow-overlay)
+ (compilation-tear-down-arrow-spec-in-margin)))))
(defvar next-error-highlight-timer)
@@ -2618,7 +2683,8 @@ and overlay is highlighted between MK and END-MK."
(highlight-regexp (with-current-buffer (marker-buffer msg)
;; also do this while we change buffer
(goto-char (marker-position msg))
- (and w (compilation-set-window w msg))
+ (and w (progn (compilation-set-window w msg)
+ (compilation-set-overlay-arrow w)))
compilation-highlight-regexp)))
;; Ideally, the window-size should be passed to `display-buffer'
;; so it's only used when creating a new window.
@@ -2739,7 +2805,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
'(nil (allow-no-window . t))))))
(with-current-buffer (marker-buffer marker)
(goto-char marker)
- (and w (compilation-set-window w marker)))
+ (and w (progn (compilation-set-window w marker)
+ (compilation-set-overlay-arrow w))))
(let* ((name (read-file-name
(format "Find this %s in (default %s): "
compilation-error filename)
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
index 2d5a47a0797..f08ba2f3681 100644
--- a/lisp/progmodes/flymake-proc.el
+++ b/lisp/progmodes/flymake-proc.el
@@ -654,7 +654,14 @@ Create parent directories as needed."
(let ((cleanup-f (flymake-proc--get-cleanup-function
(buffer-file-name))))
(flymake-log 3 "cleaning up using %s" cleanup-f)
- (funcall cleanup-f))))
+ ;; Make cleanup-f see the temporary file names
+ ;; created by its corresponding init function
+ ;; (bug#31981).
+ (let ((flymake-proc--temp-source-file-name
+ (process-get proc 'flymake-proc--temp-source-file-name))
+ (flymake-proc--temp-master-file-name
+ (process-get proc 'flymake-proc--temp-master-file-name)))
+ (funcall cleanup-f)))))
(kill-buffer output-buffer)))))))
(defun flymake-proc--panic (problem explanation)
@@ -824,6 +831,10 @@ can also be executed interactively independently of
(process-put proc 'flymake-proc--output-buffer
(generate-new-buffer
(format " *flymake output for %s*" (current-buffer))))
+ (process-put proc 'flymake-proc--temp-source-file-name
+ flymake-proc--temp-source-file-name)
+ (process-put proc 'flymake-proc--temp-master-file-name
+ flymake-proc--temp-master-file-name)
(setq flymake-proc--current-process proc)
(flymake-log 2 "started process %d, command=%s, dir=%s"
(process-id proc) (process-command proc)
@@ -865,6 +876,7 @@ can also be executed interactively independently of
(let* ((ext (file-name-extension file-name))
(temp-name (file-truename
(concat (file-name-sans-extension file-name)
+ "_" (format-time-string "%H%M%S%N")
"_" prefix
(and ext (concat "." ext))))))
(flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 30d4b199110..235546ef2e4 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1610,7 +1610,9 @@ and source-file directory for your debugger."
;; characters we match in the file name shown in the prompt.
;; (Of course, this matches the "<string>" case too.)
(defvar gud-pdb-marker-regexp
- "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|<module>\\)()\\(->[^\n\r]*\\)?[\n\r]")
+ (concat "^> \\([[:graph:] \\]*\\)(\\([0-9]+\\))\\([a-zA-Z0-9_]*\\|\\?\\|"
+ "<\\(?:module\\|listcomp\\|dictcomp\\|setcomp\\|genexpr\\|lambda\\|\\)>"
+ "\\)()\\(->[^\n\r]*\\)?[\n\r]"))
(defvar gud-pdb-marker-regexp-file-group 1)
(defvar gud-pdb-marker-regexp-line-group 2)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 1b06077005c..9fea447e765 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -112,28 +112,23 @@
(defcustom hide-ifdef-initially nil
"Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-read-only nil
"Set to non-nil if you want buffer to be read-only while hiding text."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-lines nil
"Non-nil means hide the #ifX, #else, and #endif lines."
- :type 'boolean
- :group 'hide-ifdef)
+ :type 'boolean)
(defcustom hide-ifdef-shadow nil
"Non-nil means shadow text instead of hiding it."
:type 'boolean
- :group 'hide-ifdef
:version "23.1")
(defface hide-ifdef-shadow '((t (:inherit shadow)))
"Face for shadowing ifdef blocks."
- :group 'hide-ifdef
:version "23.1")
(defcustom hide-ifdef-exclude-define-regexp nil
@@ -168,7 +163,6 @@ This behavior is generally undesirable. If this option is non-nil, the outermos
"C/C++ header file name patterns to determine if current buffer is a header.
Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
:type 'string
- :group 'hide-ifdef
:version "25.1")
(defvar hide-ifdef-mode-submap
@@ -196,8 +190,10 @@ Effective only if `hide-ifdef-expand-reinclusion-protection' is t."
map)
"Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
-(defconst hide-ifdef-mode-prefix-key "\C-c@"
- "Prefix key for all Hide-Ifdef mode commands.")
+(defcustom hide-ifdef-mode-prefix-key "\C-c@"
+ "Prefix key for all Hide-Ifdef mode commands."
+ :type 'key-sequence
+ :version "27.1")
(defvar hide-ifdef-mode-map
;; Set up the mode's main map, which leads via the prefix key to the submap.
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index cb39e62265d..8d3513bad30 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -39,7 +39,8 @@
(defcustom prog-mode-hook nil
"Normal hook run when entering programming modes."
:type 'hook
- :options '(flyspell-prog-mode abbrev-mode flymake-mode linum-mode
+ :options '(flyspell-prog-mode abbrev-mode flymake-mode
+ display-line-numbers-mode
prettify-symbols-mode)
:group 'prog-mode)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ae35766ecdc..eef2ca643f6 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -728,7 +728,11 @@ references displayed in the current *xref* buffer."
"Mode for displaying cross-references."
(setq buffer-read-only t)
(setq next-error-function #'xref--next-error-function)
- (setq next-error-last-buffer (current-buffer)))
+ (setq next-error-last-buffer (current-buffer))
+ (setq imenu-prev-index-position-function
+ #'xref--imenu-prev-index-position)
+ (setq imenu-extract-index-name-function
+ #'xref--imenu-extract-index-name))
(defvar xref--transient-buffer-mode-map
(let ((map (make-sparse-keymap)))
@@ -740,6 +744,22 @@ references displayed in the current *xref* buffer."
xref--xref-buffer-mode
"XREF Transient")
+(defun xref--imenu-prev-index-position ()
+ "Move point to previous line in `xref' buffer.
+This function is used as a value for
+`imenu-prev-index-position-function'."
+ (if (bobp)
+ nil
+ (xref--search-property 'xref-group t)))
+
+(defun xref--imenu-extract-index-name ()
+ "Return imenu name for line at point.
+This function is used as a value for
+`imenu-extract-index-name-function'. Point should be at the
+beginning of the line."
+ (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position)))
+
(defun xref--next-error-function (n reset?)
(when reset?
(goto-char (point-min)))
@@ -789,7 +809,8 @@ GROUP is a string for decoration purposes and XREF is an
for line-format = (and max-line-width
(format "%%%dd: " max-line-width))
do
- (xref--insert-propertized '(face xref-file-header) group "\n")
+ (xref--insert-propertized '(face xref-file-header 'xref-group t)
+ group "\n")
(cl-loop for (xref . more2) on xrefs do
(with-slots (summary location) xref
(let* ((line (xref-location-line location))
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 8dd1d1e2bf2..5956c9f0811 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1320,29 +1320,18 @@ Please send all bug fixes and enhancements to
;; Known bugs and limitations of ps-print
;; --------------------------------------
;;
-;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
-;; particular, bold or italic fonts don't print in the right background color.
-;;
-;; Invisible properties aren't correctly ignored in XEmacs 19.12.
-;;
;; Automatic font-attribute detection doesn't work well, especially with
;; hilit19 and older versions of get-create-face. Users having problems with
;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
;; and `ps-underlined-faces' and/or turn off automatic detection by setting
;; `ps-auto-font-detect' to nil.
;;
-;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
-;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
-;; `ps-underlined-faces' instead.
-;;
;; Still too slow; could use some hand-optimization.
;;
;; Default background color isn't working.
;;
;; Faces are always treated as opaque.
;;
-;; Epoch, Lucid and Emacs 22 not supported. At all.
-;;
;; Fixed-pitch fonts work better for line folding, but are not required.
;;
;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 4112b44e484..2720286814a 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -1184,9 +1184,6 @@ IGNORE other arguments."
:format "%[%t\n%]"
:help-echo ,(concat "Open " (cdr menu-element))
:action recentf-open-files-action
- ;; Override the (problematic) follow-link property of the
- ;; `link' widget (bug#22434).
- :follow-link nil
,(cdr menu-element))))
(defun recentf-open-files-items (files)
diff --git a/lisp/server.el b/lisp/server.el
index d491a260377..ac81cdbd483 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -926,12 +926,11 @@ This handles splitting the command if it would be bigger than
(isearch-cancel))))
;; Signaled by isearch-cancel.
(quit (message nil)))
- (when (> (recursion-depth) 0)
+ (when (> (minibuffer-depth) 0)
;; We're inside a minibuffer already, so if the emacs-client is trying
;; to open a frame on a new display, we might end up with an unusable
;; frame because input from that display will be blocked (until exiting
;; the minibuffer). Better exit this minibuffer right away.
- ;; Similarly with recursive-edits such as the splash screen.
(run-with-timer 0 nil (lambda () (server-execute-continuation proc)))
(top-level)))
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 07e78506654..2778e583674 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -165,6 +165,9 @@ created by `shadow-define-regexp-group'.")
(defvar shadow-info-buffer nil) ; buf visiting shadow-info-file
(defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file
+(defvar shadow-debug nil
+ "Use for debug messages.")
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Syntactic sugar; General list and string manipulation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -631,6 +634,10 @@ Consider them as regular expressions if third arg REGEXP is true."
(let ((shadows (shadow-shadows-of
(shadow-expand-file-name
(buffer-file-name (current-buffer))))))
+ (when shadow-debug
+ (message
+ "shadow-add-to-todo: %s %s\n%s"
+ shadows shadow-files-to-copy (with-output-to-string (backtrace))))
(when shadows
(setq shadow-files-to-copy
(shadow-union shadows shadow-files-to-copy))
@@ -644,6 +651,10 @@ Consider them as regular expressions if third arg REGEXP is true."
(defun shadow-remove-from-todo (pair)
"Remove PAIR from `shadow-files-to-copy'.
PAIR must be `eq' to one of the elements of that list."
+ (when shadow-debug
+ (message
+ "shadow-remove-from-todo: %s %s\n%s"
+ pair shadow-files-to-copy (with-output-to-string (backtrace))))
(setq shadow-files-to-copy
(cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy)))
@@ -673,7 +684,7 @@ Return t unless files were locked; then return nil."
(eval-buffer))
(when shadow-todo-file
(set-buffer (setq shadow-todo-buffer
- (find-file-noselect shadow-todo-file)))
+ (find-file-noselect shadow-todo-file 'nowarn)))
(when (and (not (buffer-modified-p))
(file-newer-than-file-p (make-auto-save-file-name)
shadow-todo-file))
@@ -714,6 +725,8 @@ With non-nil argument also saves the buffer."
(if save (shadow-save-todo-file))))
(defun shadow-save-todo-file ()
+ (when shadow-debug
+ (message "shadow-save-todo-file:\n%s" (with-output-to-string (backtrace))))
(if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
(with-current-buffer shadow-todo-buffer
(condition-case nil ; have to continue even in case of
@@ -769,7 +782,7 @@ look for files that have been changed and need to be copied to other systems."
(buffer-list))))
(yes-or-no-p "Modified buffers exist; exit anyway? "))
(or (not (fboundp 'process-list))
- ;; process-list is not defined on MSDOS.
+ ;; `process-list' is not defined on MSDOS.
(let ((processes (process-list))
active)
(while processes
diff --git a/lisp/shell.el b/lisp/shell.el
index 2914d1d2c81..fb2c36fa733 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -184,13 +184,16 @@ shell buffer. The value may depend on the operating system or shell."
shell-environment-variable-completion
shell-command-completion
shell-c-a-p-replace-by-expanded-directory
- pcomplete-completions-at-point
shell-filename-completion
- comint-filename-completion)
+ comint-filename-completion
+ ;; Put `pcomplete-completions-at-point' last so that other
+ ;; functions can run before it does, see bug#34330.
+ pcomplete-completions-at-point)
"List of functions called to perform completion.
This variable is used to initialize `comint-dynamic-complete-functions' in the
shell buffer."
:type '(repeat function)
+ :version "27.1"
:group 'shell)
(defcustom shell-command-regexp "[^;&|\n]+"
@@ -553,6 +556,8 @@ Variables `comint-output-filter-functions', a hook, and
`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
control whether input and output cause the window to scroll to the end of the
buffer."
+ (when (called-interactively-p 'any)
+ (error "Can't be called interactively; did you mean `shell-script-mode' instead?"))
(setq comint-prompt-regexp shell-prompt-pattern)
(shell-completion-vars)
(setq-local paragraph-separate "\\'")
diff --git a/lisp/simple.el b/lisp/simple.el
index 84497c31b25..358b6a4f200 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1587,10 +1587,8 @@ display the result of expression evaluation."
(let ((minibuffer-completing-symbol t))
(minibuffer-with-setup-hook
(lambda ()
- ;; FIXME: call emacs-lisp-mode?
- (add-function :before-until (local 'eldoc-documentation-function)
- #'elisp-eldoc-documentation-function)
- (eldoc-mode 1)
+ ;; FIXME: call emacs-lisp-mode (see also
+ ;; `eldoc--eval-expression-setup')?
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook))
@@ -3946,15 +3944,14 @@ interactively, this is t."
(when (and error-file (file-exists-p error-file))
(if (< 0 (file-attribute-size (file-attributes error-file)))
(with-current-buffer (get-buffer-create error-buffer)
- (let ((pos-from-end (- (point-max) (point))))
- (or (bobp)
- (insert "\f\n"))
- ;; Do no formatting while reading error file,
- ;; because that can run a shell command, and we
- ;; don't want that to cause an infinite recursion.
- (format-insert-file error-file nil)
- ;; Put point after the inserted errors.
- (goto-char (- (point-max) pos-from-end)))
+ (goto-char (point-max))
+ ;; Insert a separator if there's already text here.
+ (unless (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
(and display-error-buffer
(display-buffer (current-buffer)))))
(delete-file error-file))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index bce73d6bfef..67fc4aae151 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -105,8 +105,8 @@ are integer buffer positions in the reverse order of the insertion order.")
(defvar skeleton-regions)
(def-edebug-spec skeleton-edebug-spec
- ([&or null stringp (stringp &rest stringp) [[&not atom] def-form]]
- &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:"
+ ([&or null stringp (stringp &rest stringp) [[&not atom] sexp]]
+ &rest &or "n" "_" "-" ">" "@" "&" "!" "|" "resume:"
("quote" def-form) skeleton-edebug-spec def-form))
;;;###autoload
(defmacro define-skeleton (command documentation &rest skeleton)
diff --git a/lisp/sort.el b/lisp/sort.el
index 6ea1c440605..6ceda8e448c 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -225,11 +225,17 @@ the sort order."
(narrow-to-region beg end)
(goto-char (point-min))
(sort-subr reverse
- (function
- (lambda ()
- (while (and (not (eobp)) (looking-at paragraph-separate))
- (forward-line 1))))
- 'forward-paragraph))))
+ (lambda ()
+ (while (and (not (eobp)) (looking-at paragraph-separate))
+ (forward-line 1)))
+ (lambda ()
+ (forward-paragraph)
+ ;; If the buffer doesn't end with a newline, add a
+ ;; newline to avoid having paragraphs being
+ ;; concatenated after sorting.
+ (when (and (eobp)
+ (not (bolp)))
+ (insert "\n")))))))
;;;###autoload
(defun sort-pages (reverse beg end)
diff --git a/lisp/startup.el b/lisp/startup.el
index 564428580b1..a16db242da0 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1,4 +1,4 @@
-;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
+;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1992, 1994-2019 Free Software Foundation,
;; Inc.
@@ -490,6 +490,27 @@ DIRS are relative."
(when tail
(setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
+;; The default location for XDG-convention Emacs init files.
+(defconst startup--xdg-config-default "~/.config/emacs/")
+;; The location for XDG-convention Emacs init files.
+(defvar startup--xdg-config-home-emacs)
+
+;; Return the name of the init file directory for Emacs, assuming
+;; XDG-DIR is the XDG location and USER-NAME is the user name.
+;; If USER-NAME is nil or "", use the current user.
+;; Prefer the XDG location unless it does does not exist and the
+;; .emacs.d location does exist.
+(defun startup--xdg-or-homedot (xdg-dir user-name)
+ (if (file-exists-p xdg-dir)
+ xdg-dir
+ (let ((emacs-d-dir (concat "~" user-name
+ (if (eq system-type 'ms-dos)
+ "/_emacs.d/"
+ "/.emacs.d/"))))
+ (if (file-exists-p emacs-d-dir)
+ emacs-d-dir
+ xdg-dir))))
+
(defun normal-top-level ()
"Emacs calls this function when it first starts up.
It sets `command-line-processed', processes the command-line,
@@ -499,6 +520,14 @@ It is the default value of the variable `top-level'."
(message internal--top-level-message)
(setq command-line-processed t)
+ (setq startup--xdg-config-home-emacs
+ (let ((xdg-config-home (getenv-internal "XDG_CONFIG_HOME")))
+ (if xdg-config-home
+ (concat xdg-config-home "/emacs/")
+ startup--xdg-config-default)))
+ (setq user-emacs-directory
+ (startup--xdg-or-homedot startup--xdg-config-home-emacs nil))
+
;; Look in each dir in load-path for a subdirs.el file. If we
;; find one, load it, which will add the appropriate subdirs of
;; that dir into load-path. This needs to be done before setting
@@ -906,16 +935,19 @@ init-file, or to a default value if loading is not possible."
;; the name of the file that it loads into
;; `user-init-file'.
(setq user-init-file t)
- (load (if (equal (file-name-extension init-file-name)
- "el")
- (file-name-sans-extension init-file-name)
- init-file-name)
- 'noerror 'nomessage)
+ (when init-file-name
+ (load (if (equal (file-name-extension init-file-name)
+ "el")
+ (file-name-sans-extension init-file-name)
+ init-file-name)
+ 'noerror 'nomessage))
(when (and (eq user-init-file t) alternate-filename-function)
(let ((alt-file (funcall alternate-filename-function)))
(and (equal (file-name-extension alt-file) "el")
(setq alt-file (file-name-sans-extension alt-file)))
+ (unless init-file-name
+ (setq init-file-name alt-file))
(load alt-file 'noerror 'nomessage)))
;; If we did not find the user's init file, set
@@ -971,18 +1003,10 @@ the `--debug-init' option to view a complete error backtrace."
(when debug-on-error-should-be-set
(setq debug-on-error debug-on-error-from-init-file))))
-(defun find-init-path (fn)
- "Look in ~/.config/FOO or ~/.FOO for the dotfile or dot directory FOO.
-It is expected that the output will undergo ~ expansion. Implements the
-XDG convention for dotfiles."
- (let* ((xdg-path (concat "~" init-file-user "/.config/" fn))
- (oldstyle-path (concat "~" init-file-user "/." fn))
- (found-path (if (file-exists-p xdg-path) xdg-path oldstyle-path)))
- found-path))
-
(defun command-line ()
"A subroutine of `normal-top-level'.
Amongst another things, it parses the command-line arguments."
+ (let (xdg-dir startup-init-directory)
(setq before-init-time (current-time)
after-init-time nil
command-line-default-directory default-directory)
@@ -1171,6 +1195,19 @@ please check its value")
init-file-user))
:error))))
+ ;; Calculate the name of the Emacs init directory.
+ ;; This is typically ~INIT-FILE-USER/.config/emacs unless the user
+ ;; is following the ~INIT-FILE-USER/.emacs.d convention.
+ (setq xdg-dir startup--xdg-config-home-emacs)
+ (setq startup-init-directory
+ (if (or (zerop (length init-file-user))
+ (and (eq xdg-dir user-emacs-directory)
+ (not (eq xdg-dir startup--xdg-config-default))))
+ user-emacs-directory
+ ;; The name is not obvious, so access more directories to calculate it.
+ (setq xdg-dir (concat "~" init-file-user "/.config/emacs/"))
+ (startup--xdg-or-homedot xdg-dir init-file-user)))
+
;; Load the early init file, if found.
(startup--load-user-init-file
(lambda ()
@@ -1180,8 +1217,7 @@ please check its value")
;; with the .el extension, if the file doesn't exist, not just
;; "early-init" without an extension, as it does for ".emacs".
"early-init.el"
- (file-name-as-directory
- (find-init-path "emacs.d")))))
+ startup-init-directory)))
(setq early-init-file user-init-file)
;; If any package directory exists, initialize the package system.
@@ -1319,10 +1355,11 @@ please check its value")
(startup--load-user-init-file
(lambda ()
(cond
+ ((eq startup-init-directory xdg-dir) nil)
((eq system-type 'ms-dos)
(concat "~" init-file-user "/_emacs"))
((not (eq system-type 'windows-nt))
- (find-init-path "emacs"))
+ (concat "~" init-file-user "/.emacs"))
;; Else deal with the Windows situation.
((directory-files "~" nil "^\\.emacs\\(\\.elc?\\)?$")
;; Prefer .emacs on Windows.
@@ -1339,8 +1376,7 @@ please check its value")
(lambda ()
(expand-file-name
"init"
- (file-name-as-directory
- (find-init-path "emacs.d"))))
+ startup-init-directory))
(not inhibit-default-init))
(when (and deactivate-mark transient-mark-mode)
@@ -1456,7 +1492,7 @@ Consider using a subdirectory instead, e.g.: %s"
(if (and (boundp 'x-session-previous-id)
(stringp x-session-previous-id))
(with-no-warnings
- (emacs-session-restore x-session-previous-id))))
+ (emacs-session-restore x-session-previous-id)))))
(defun x-apply-session-resources ()
"Apply X resources which specify initial values for Emacs variables.
diff --git a/lisp/subr.el b/lisp/subr.el
index b22db65bb64..0d7bffb35f3 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2937,11 +2937,9 @@ When the hook runs, the temporary buffer is current.
This hook is normally set up with a function to put the buffer in Help
mode.")
-(defconst user-emacs-directory
- (if (eq system-type 'ms-dos)
- ;; MS-DOS cannot have initial dot.
- "~/_emacs.d/"
- "~/.emacs.d/")
+(defvar user-emacs-directory
+ ;; The value does not matter since Emacs sets this at startup.
+ nil
"Directory beneath which additional per-user Emacs-specific files are placed.
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 713f3d944bc..8e7e1945cbc 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -450,6 +450,7 @@ checksum before doing the check."
(progn (beep) (message "Invalid checksum for file %s!" file-name))))
(defun tar-clip-time-string (time)
+ (declare (obsolete format-time-string "27.1"))
(let ((str (current-time-string time)))
(concat " " (substring str 4 16) (format-time-string " %Y" time))))
@@ -508,7 +509,9 @@ MODE should be an integer which is a file mode value."
(if (= 0 (length uname)) uid uname)
(if (= 0 (length gname)) gid gname)
size
- (if tar-mode-show-date (tar-clip-time-string time) "")
+ (if tar-mode-show-date
+ (format-time-string " %Y-%m-%d %H:%M" time)
+ "")
(propertize name
'mouse-face 'highlight
'help-echo "mouse-2: extract this file into a buffer")
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 9dfa9f3c448..5c77e03b0b2 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -394,7 +394,12 @@ for language-specific arguments."
"Indicates whether ispell should skip spell checking of SGML markup.
If t, always skip SGML markup; if nil, never skip; if non-t and non-nil,
guess whether SGML markup should be skipped according to the name of the
-buffer's major mode."
+buffer's major mode.
+
+SGML markup is any text inside the brackets \"<>\" or entities
+such as \"&amp;\". See `ispell-html-skip-alists' for more details.
+
+This variable affects spell-checking of HTML, XML, and SGML files."
:type '(choice (const :tag "always" t) (const :tag "never" nil)
(const :tag "use-mode-name" use-mode-name))
:group 'ispell)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index bf76652f401..c1c863876b5 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -240,8 +240,6 @@ instead of executing it."
(car elt)))
tmm-km-list)))))
(setq history-len (length tmm--history))
- (setq tmm--history (append tmm--history tmm--history
- tmm--history tmm--history))
(setq tmm-c-prompt (nth (- history-len 1 index-of-default)
tmm--history))
(setq out
@@ -249,18 +247,17 @@ instead of executing it."
(car (nth index-of-default tmm-km-list))
(minibuffer-with-setup-hook #'tmm-add-prompt
;; tmm-km-list is reversed, because history
- ;; needs it in LIFO order. But completion
+ ;; needs it in LIFO order. But default list
;; needs it in non-reverse order, so that the
- ;; menu items are displayed as completion
- ;; candidates in the order they are shown on
- ;; the menu bar. So pass completing-read the
+ ;; menu items are displayed by M-n as default
+ ;; values in the order they are shown on
+ ;; the menu bar. So pass the DEFAULT arg the
;; reversed copy of the list.
(completing-read-default
(concat gl-str
" (up/down to change, PgUp to menu): ")
- (tmm--completion-table (reverse tmm-km-list)) nil t nil
- (cons 'tmm--history
- (- (* 2 history-len) index-of-default))))))))
+ (tmm--completion-table tmm-km-list) nil t nil
+ 'tmm--history (reverse tmm--history)))))))
(setq choice (cdr (assoc out tmm-km-list)))
(and (null choice)
(string-prefix-p tmm-c-prompt out)
@@ -404,8 +401,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
;; Try to show everything just inserted and preserve height of
;; *Completions* window. This should fix a behavior described
;; in Bug#1291.
- (fit-window-to-buffer window nil nil nil nil t)))))
- (insert tmm-c-prompt))
+ (fit-window-to-buffer window nil nil nil nil t))))))
(defun tmm-shortcut ()
"Choose the shortcut that the user typed."
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index f287adf2423..c2a5a6f70c6 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1359,6 +1359,8 @@ commands, which only operated on marked files."
(mapcar (lambda (arg) (list "-r" arg)) marked-list)))
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
+ ;; Disable pager.
+ (process-environment (cons "HGPLAIN=1" process-environment))
(hg-program vc-hg-program)
args)
;; If necessary, prompt for the exact command.
@@ -1431,7 +1433,9 @@ call \"hg push -r REVS\" to push the specified revisions REVS."
"Merge incoming changes into the current working directory.
This runs the command \"hg merge\"."
(let* ((root (vc-hg-root default-directory))
- (buffer (format "*vc-hg : %s*" (expand-file-name root))))
+ (buffer (format "*vc-hg : %s*" (expand-file-name root)))
+ ;; Disable pager.
+ (process-environment (cons "HGPLAIN=1" process-environment)))
(apply 'vc-do-async-command buffer root vc-hg-program '("merge"))
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
@@ -1442,11 +1446,13 @@ This runs the command \"hg merge\"."
"A wrapper around `vc-do-command' for use in vc-hg.el.
This function differs from vc-do-command in that it invokes
`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS."
- (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
- (if (stringp vc-hg-global-switches)
- (cons vc-hg-global-switches flags)
- (append vc-hg-global-switches
- flags))))
+ ;; Disable pager.
+ (let ((process-environment (cons "HGPLAIN=1" process-environment)))
+ (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list
+ (if (stringp vc-hg-global-switches)
+ (cons vc-hg-global-switches flags)
+ (append vc-hg-global-switches
+ flags)))))
(defun vc-hg-root (file)
(vc-find-root file ".hg"))
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dd03a24bb36..9bc7a076eec 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1790,17 +1790,22 @@ If END is omitted, it defaults to the length of LIST."
:type 'string
:group 'widget-button)
+(defvar widget-link-keymap
+ (let ((map (copy-keymap widget-keymap)))
+ ;; Only bind mouse-2, since mouse-1 will be translated accordingly to
+ ;; the customization of `mouse-1-click-follows-link'.
+ (define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1]))
+ (define-key map [down-mouse-2] 'widget-button-click)
+ (define-key map [mouse-2] 'widget-button-click)
+ map)
+ "Keymap used inside a link widget.")
+
(define-widget 'link 'item
"An embedded link."
:button-prefix 'widget-link-prefix
:button-suffix 'widget-link-suffix
- ;; The `follow-link' property should only be used in those contexts where the
- ;; mouse-1 event normally doesn't follow the link, yet the `link' widget
- ;; seems to almost always be used in contexts where (down-)mouse-1 is bound
- ;; to `widget-button-click' and hence the "mouse-1 to mouse-2" remapping is
- ;; not necessary (and can even be harmful). So let's not add a :follow-link
- ;; by default. See (bug#22434).
- ;; :follow-link 'mouse-face
+ :follow-link 'mouse-face
+ :keymap widget-link-keymap
:help-echo "Follow the link."
:format "%[%t%]")
@@ -3078,7 +3083,9 @@ as the value."
(define-widget 'file 'string
"A file widget.
It reads a file name from an editable text field."
- :completions #'completion-file-name-table
+ :completions (completion-table-case-fold
+ #'completion-file-name-table
+ (not read-file-name-completion-ignore-case))
:prompt-value 'widget-file-prompt-value
:format "%{%t%}: %v"
;; Doesn't work well with terminating newline.
@@ -3113,6 +3120,11 @@ It reads a file name from an editable text field."
(define-widget 'directory 'file
"A directory widget.
It reads a directory name from an editable text field."
+ :completions (apply-partially #'completion-table-with-predicate
+ (completion-table-case-fold
+ #'completion-file-name-table
+ (not read-file-name-completion-ignore-case))
+ #'directory-name-p 'strict)
:tag "Directory")
(defvar widget-symbol-prompt-value-history nil
@@ -3328,13 +3340,13 @@ It reads a directory name from an editable text field."
(condition-case data ;Note: We get a spurious byte-compile warning here.
(progn
;; Avoid a confusing end-of-file error.
- (skip-syntax-forward "\\s-")
+ (skip-syntax-forward "-")
(if (eobp)
(setq err "Empty sexp -- use nil?")
(unless (widget-apply widget :match (read (current-buffer)))
(setq err (widget-get widget :type-error))))
;; Allow whitespace after expression.
- (skip-syntax-forward "\\s-")
+ (skip-syntax-forward "-")
(if (and (not (eobp))
(not err))
(setq err (format "Junk at end of expression: %s"
diff --git a/lisp/window.el b/lisp/window.el
index 80dbd64f18a..cf733153b89 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4849,7 +4849,7 @@ all window-local buffer lists."
(unrecord-window-buffer window buffer)))))
(defcustom quit-window-hook nil
- "Hook run before performing any other actions in the `quit-buffer' command."
+ "Hook run before performing any other actions in the `quit-window' command."
:type 'hook
:version "27.1"
:group 'windows)
@@ -4882,11 +4882,7 @@ nil means to not handle the buffer in a particular way. This
most reliable remedy to not have `switch-to-prev-buffer' switch
to this buffer again without killing the buffer.
-`kill' means to kill WINDOW's buffer.
-
-The functions in `quit-window-hook' will be run before doing
-anything else."
- (run-hooks 'quit-window-hook)
+`kill' means to kill WINDOW's buffer."
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(quit-restore (window-parameter window 'quit-restore))
@@ -4986,6 +4982,10 @@ one. If non-nil, reset `quit-restore' parameter to nil.
The functions in `quit-window-hook' will be run before doing
anything else."
(interactive "P")
+ ;; Run the hook from the buffer implied to get any buffer-local
+ ;; values.
+ (with-current-buffer (window-buffer (window-normalize-window window))
+ (run-hooks 'quit-window-hook))
(quit-restore-window window (if kill 'kill 'bury)))
(defun quit-windows-on (&optional buffer-or-name kill frame)