[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 37e0dbc: Merge remote-tracking branch 'savannah/mast
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 37e0dbc: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Sun, 19 Jul 2020 15:57:15 -0400 (EDT) |
branch: feature/native-comp
commit 37e0dbc97242a69da9f02039f5635261a307659a
Merge: 907618b 5d2a83e
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Merge remote-tracking branch 'savannah/master' into HEAD
---
doc/lispref/processes.texi | 5 +-
doc/misc/eww.texi | 8 ++
doc/misc/gnus.texi | 55 ++++++------
etc/NEWS | 39 ++++++--
lisp/descr-text.el | 4 +-
lisp/emacs-lisp/eldoc.el | 154 ++++++++++++++++----------------
lisp/emacs-lisp/text-property-search.el | 18 ++--
lisp/frame.el | 3 +-
lisp/gnus/gnus-agent.el | 15 +++-
lisp/gnus/gnus-art.el | 41 +++++----
lisp/gnus/gnus-group.el | 10 +--
lisp/gnus/gnus-kill.el | 2 +-
lisp/gnus/gnus-msg.el | 6 +-
lisp/gnus/gnus-registry.el | 28 +++---
lisp/gnus/gnus-start.el | 88 +++++++++---------
lisp/gnus/gnus-sum.el | 20 +++--
lisp/gnus/gnus.el | 40 ++++++---
lisp/gnus/nntp.el | 12 ++-
lisp/mail/emacsbug.el | 8 +-
lisp/net/eww.el | 46 +++++++---
lisp/net/network-stream.el | 64 +++++++++----
lisp/net/shr.el | 97 ++++++++++++++------
lisp/net/tramp-adb.el | 2 +-
lisp/progmodes/bug-reference.el | 64 ++++++++++++-
lisp/progmodes/cc-mode.el | 102 +++++++++------------
lisp/progmodes/project.el | 1 +
lisp/tab-bar.el | 3 +-
lisp/url/url-http.el | 33 +++----
lisp/url/url-queue.el | 29 +++---
lisp/windmove.el | 4 +-
lisp/window.el | 16 +++-
src/image.c | 5 +-
32 files changed, 643 insertions(+), 379 deletions(-)
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 22c5093..4002004 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2511,7 +2511,10 @@ If non-@code{nil}, always ask for the server's
capabilities, even when
doing a @samp{plain} connection.
@item :capability-command @var{capability-command}
-Command string to query the host capabilities.
+Command to query the host capabilities. This can either be a string
+(which will then be sent verbatim to the server), or a function
+(called with a single parameter; the "greeting" from the server when
+connecting), and should return a string.
@item :end-of-command @var{regexp}
@itemx :end-of-capability @var{regexp}
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index e3191cb..9bca0fa 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -283,6 +283,14 @@ contrast. If that is still too low for you, you can
customize the
variables @code{shr-color-visible-distance-min} and
@code{shr-color-visible-luminance-min} to get a better contrast.
+@vindex shr-max-width
+@vindex shr-width
+ By default, the max width used when rendering is 120 characters, but
+this can be adjusted by changing the @code{shr-max-width} variable.
+If a specified width is preferred no matter what the width of the
+window is, @code{shr-width} can be set. If both variables are
+@code{nil}, the window width will always be used.
+
@vindex shr-discard-aria-hidden
@cindex @code{aria-hidden}, HTML attribute
The HTML attribute @code{aria-hidden} is meant to tell screen
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 718e269..2f4bc0c 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -436,7 +436,7 @@ Starting Gnus
* Finding the News:: Choosing a method for getting news.
* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a
time.
+* Child Gnusae:: You can have more than one Gnus active at a
time.
* Fetching a Group:: Starting Gnus just to read a group.
* New Groups:: What is Gnus supposed to do with new groups?
* Changing Servers:: You may want to move from one server to
another.
@@ -976,7 +976,7 @@ terminology section (@pxref{Terminology}).
@menu
* Finding the News:: Choosing a method for getting news.
* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a time.
+* Child Gnusae:: You can have more than one Gnus active at a time.
* New Groups:: What is Gnus supposed to do with new groups?
* Changing Servers:: You may want to move from one server to another.
* Startup Files:: Those pesky startup files---@file{.newsrc}.
@@ -1090,9 +1090,9 @@ your primary server---instead, it will just activate all
groups on level
levels.) Also @pxref{Group Levels}.
-@node Slave Gnusae
-@section Slave Gnusae
-@cindex slave
+@node Child Gnusae
+@section Child Gnusae
+@cindex child
You might want to run more than one Emacs with more than one Gnus at the
same time. If you are using different @file{.newsrc} files (e.g., if you
@@ -1103,31 +1103,27 @@ The problem appears when you want to run two Gnusae
that use the same
@file{.newsrc} file.
To work around that problem some, we here at the Think-Tank at the Gnus
-Towers have come up with a new concept: @dfn{Masters} and
-@dfn{slaves}. (We have applied for a patent on this concept, and have
-taken out a copyright on those words. If you wish to use those words in
-conjunction with each other, you have to send $1 per usage instance to
-me. Usage of the patent (@dfn{Master/Slave Relationships In Computer
-Applications}) will be much more expensive, of course.)
-
-@findex gnus-slave
+Towers have come up with a new concept: @dfn{Parents} and
+@dfn{children}.
+
+@findex gnus-child
Anyway, you start one Gnus up the normal way with @kbd{M-x gnus} (or
-however you do it). Each subsequent slave Gnusae should be started with
-@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc}
-files, but instead save @dfn{slave files} that contain information only
-on what groups have been read in the slave session. When a master Gnus
-starts, it will read (and delete) these slave files, incorporating all
-information from them. (The slave files will be read in the sequence
+however you do it). Each subsequent child Gnusae should be started with
+@kbd{M-x gnus-child}. These children won't save normal @file{.newsrc}
+files, but instead save @dfn{child files} that contain information only
+on what groups have been read in the child session. When a parent Gnus
+starts, it will read (and delete) these child files, incorporating all
+information from them. (The child files will be read in the sequence
they were created, so the latest changes will have precedence.)
-Information from the slave files has, of course, precedence over the
-information in the normal (i.e., master) @file{.newsrc} file.
+Information from the child files has, of course, precedence over the
+information in the normal (i.e., parent) @file{.newsrc} file.
-If the @file{.newsrc*} files have not been saved in the master when the
-slave starts, you may be prompted as to whether to read an auto-save
-file. If you answer ``yes'', the unsaved changes to the master will be
-incorporated into the slave. If you answer ``no'', the slave may see some
-messages as unread that have been read in the master.
+If the @file{.newsrc*} files have not been saved in the parent when the
+child starts, you may be prompted as to whether to read an auto-save
+file. If you answer ``yes'', the unsaved changes to the parent will be
+incorporated into the child. If you answer ``no'', the child may see some
+messages as unread that have been read in the parent.
@@ -9064,6 +9060,9 @@ when filling.
@findex gnus-article-fill-long-lines
Fill long lines (@code{gnus-article-fill-long-lines}).
+You can give the command a numerical prefix to specify the width to use
+when filling.
+
@item W C
@kindex W C @r{(Summary)}
@findex gnus-article-capitalize-sentences
@@ -28487,9 +28486,9 @@ entry.
The format spec @code{%C} for positioning point has changed to @code{%*}.
@item
-@code{gnus-slave-unplugged}
+@code{gnus-child-unplugged}
-A new command which starts Gnus offline in slave mode.
+A new command which starts Gnus offline in child mode.
@end itemize
diff --git a/etc/NEWS b/etc/NEWS
index 2afd4de..7c6c9fe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -207,6 +207,16 @@ Bookmark locations can refer to VC directory buffers.
** Gnus
++++
+*** The name of dependent Gnus sessions has changed from "slave" to "child".
+The names of the commands 'gnus-slave', 'gnus-slave-no-server' and
+'gnus-slave-unplugged' have changed to 'gnus-child',
+'gnus-child-no-server' and 'gnus-child-unplugged' respectively.
+
++++
+*** The 'W Q' summary mode command now takes a numerical prefix to
+allow adjusting the fill width.
+
---
*** Change to default value of 'message-draft-headers' user option.
The 'Date' symbol has been removed from the default value, meaning that
@@ -470,6 +480,16 @@ This is still the case by default, but if you customize
'browse-url-mailto-function' or 'browse-url-handlers' to call some
other function, it will now be called instead of the default.
++++
+*** New variable 'shr-max-width'.
+If this variable is non-nil, and 'shr-width' is nil, then SHR will use
+the value of 'shr-max-width' to limit the width of the rendered HTML.
+The default is 120 characters, so even if you have very wide frames,
+HTML text will be rendered more narrowly, which usually leads to a
+more readable text. Set this variable to nil to get the previous
+behavior of rendering as wide as the window-width allows. If
+'shr-width' is non-nil, it overrides this variable.
+
** EWW
---
@@ -542,13 +562,14 @@ truncation, amongst other things.
'bug-reference-prog-mode' have been activated, their respective hook
has been run and still 'bug-reference-bug-regexp' and
'bug-reference-url-format' aren't both set, it tries to guess
-appropriate values for those two variables. There are two guessing
+appropriate values for those two variables. There are three guessing
mechanisms so far: based on version control information of the current
-buffer's file, and based on newsgroup/mail-folder name and several
-news and mail message headers in Gnus buffers. Both mechanisms are
-extensible with custom rules, see the variables
-'bug-reference-setup-from-vc-alist' and
-'bug-reference-setup-from-mail-alist'.
+buffer's file, based on newsgroup/mail-folder name and several news
+and mail message headers in Gnus buffers, and based on IRC channel and
+server in rcirc buffers. All mechanisms are extensible with custom
+rules, see the variables 'bug-reference-setup-from-vc-alist',
+'bug-reference-setup-from-mail-alist', and
+'bug-reference-setup-from-irc-alist'.
* New Modes and Packages in Emacs 28.1
@@ -670,6 +691,12 @@ for encoding and decoding without having to bind
'coding-system-for-{read,write}' or call 'set-process-coding-system'.
+++
+** 'open-network-stream' can now take a :capability-command that's a function.
+The function is called with the greeting from the server as its only
+parameter, and allows sending different TLS capability commands to the
+server based on that greeting.
+
++++
** 'open-gnutls-stream' now also accepts a ':coding' argument.
+++
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index be5e014..55f0b7d 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -781,8 +781,8 @@ The character information includes:
(let ((chars (match-string 1 (car composition))))
(dotimes (i (length chars))
(let ((char (aref chars i)))
- (insert (format " %c (#x%x) %s\n"
- char char
+ (insert (format " %s (#x%x) %s\n"
+ (describe-char-padded-string
char) char
(get-char-code-property
char 'name))))))))
;; TTY frame: show composition in terms of characters.
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 510dff9..6ed5bff 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -429,7 +429,7 @@ Honor most of `eldoc-echo-area-use-multiline-p'."
(integer val)
(t 1)))
(things-reported-on)
- single-sym-name)
+ single-doc single-doc-sym)
;; Then, compose the contents of the `*eldoc*' buffer.
(with-current-buffer (eldoc-doc-buffer)
(let ((inhibit-read-only t))
@@ -454,20 +454,24 @@ Honor most of `eldoc-echo-area-use-multiline-p'."
(mapconcat (lambda (s) (format "%s" s))
things-reported-on
", ")))))
- ;; Finally, output to the echo area. We handle the
- ;; `truncate-sym-name-if-fit' special case first, by selecting a
- ;; top-section of the `*eldoc' buffer. I'm pretty sure nicer
+ ;; Finally, output to the echo area. I'm pretty sure nicer
;; strategies can be used here, probably by splitting this
;; function into some `eldoc-display-functions' special hook.
(let ((echo-area-message
(cond
- ((and
+ (;; We handle the `truncate-sym-name-if-fit' special
+ ;; case first, by checking if for a lot of special
+ ;; conditions.
+ (and
(eq 'truncate-sym-name-if-fit eldoc-echo-area-use-multiline-p)
(null (cdr docs))
- (setq single-sym-name
+ (setq single-doc (caar docs))
+ (setq single-doc-sym
(format "%s" (plist-get (cdar docs) :thing)))
- (> (+ (length (caar docs)) (length single-sym-name) 2) width))
- (caar docs))
+ (< (length single-doc) width)
+ (not (string-match "\n" single-doc))
+ (> (+ (length single-doc) (length single-doc-sym) 2) width))
+ single-doc)
((> available 1)
(with-current-buffer (eldoc-doc-buffer)
(cl-loop
@@ -497,7 +501,7 @@ Honor most of `eldoc-echo-area-use-multiline-p'."
;; Truncate "brutally." ; FIXME: use `eldoc-prefer-doc-buffer'
too?
(with-current-buffer (eldoc-doc-buffer)
(truncate-string-to-width
- (buffer-substring (point-min) (line-end-position 1))
width))))))
+ (buffer-substring (goto-char (point-min)) (line-end-position
1)) width))))))
(when echo-area-message
(eldoc--message echo-area-message))))))
@@ -664,75 +668,75 @@ have the following values:
"Invoke `eldoc-documentation-strategy' function.
That function's job is to run the `eldoc-documentation-functions'
-special hook, using the `run-hook' family of functions. The way
-we invoke it here happens in a way strategy function can itself
-call `eldoc--make-callback' to produce values to give to the
-elements of the special hook `eldoc-documentation-functions'.
-
-For each element of `eldoc-documentation-functions' invoked a
-corresponding call to `eldoc--make-callback' must be made. See
-docstring of `eldoc--make-callback' for the types of callback
-that can be produced.
-
-If the strategy function does not use `eldoc--make-callback', it
-must find some alternate way to produce callbacks to feed to
-`eldoc-documentation-function', and those callbacks should
-endeavour to display the docstrings given to them."
- (let* (;; how many docstrings callbaks have been
+special hook, using the `run-hook' family of functions. ElDoc's
+built-in strategy functions play along with the
+`eldoc--make-callback' protocol, using it to produce callback to
+feed to the functgions of `eldoc-documentation-functions'.
+
+Other third-party strategy functions do not use
+`eldoc--make-callback'. They must find some alternate way to
+produce callbacks to feed to `eldoc-documentation-function' and
+should endeavour to display the docstrings eventually produced."
+ (let* (;; How many callbacks have been created by the strategy
+ ;; fucntion and passed to elements of
+ ;; `eldoc-documentation-functions'.
(howmany 0)
- ;; how many calls to callbacks we're waiting on. Used by
- ;; `:patient'.
+ ;; How many calls to callbacks we're still waiting on. Used
+ ;; by `:patient'.
(want 0)
- ;; how many doc strings and corresponding options have been
- ;; registered it.
+ ;; The doc strings and corresponding options registered so
+ ;; far.
(docs-registered '()))
- (cl-labels
- ((register-doc (pos string plist)
- (when (and string (> (length string) 0))
- (push (cons pos (cons string plist)) docs-registered)))
- (display-doc ()
- (eldoc--handle-docs
- (mapcar #'cdr
- (setq docs-registered
- (sort docs-registered
- (lambda (a b) (< (car a) (car b))))))))
- (make-callback (method)
- (let ((pos (prog1 howmany (cl-incf howmany))))
- (cl-ecase method
- (:enthusiast
- (lambda (string &rest plist)
- (when (and string (cl-loop for (p) in docs-registered
- never (< p pos)))
- (setq docs-registered '())
- (register-doc pos string plist)
- (when (and (timerp eldoc--enthusiasm-curbing-timer)
- (memq eldoc--enthusiasm-curbing-timer
- timer-list))
- (cancel-timer eldoc--enthusiasm-curbing-timer))
- (setq eldoc--enthusiasm-curbing-timer
- (run-at-time (unless (zerop pos) 0.3)
- nil #'display-doc)))
- t))
- (:patient
- (cl-incf want)
- (lambda (string &rest plist)
- (register-doc pos string plist)
- (when (zerop (cl-decf want)) (display-doc))
- t))
- (:eager
- (lambda (string &rest plist)
- (register-doc pos string plist)
- (display-doc)
- t))))))
- (let* ((eldoc--make-callback #'make-callback)
- (res (funcall eldoc-documentation-strategy)))
- ;; Observe the old and the new protocol:
- (cond (;; Old protocol: got string, output immediately;
- (stringp res) (register-doc 0 res nil) (display-doc))
- (;; Old protocol: got nil, clear the echo area;
- (null res) (eldoc--message nil))
- (;; New protocol: trust callback will be called;
- t))))))
+ (cl-labels
+ ((register-doc
+ (pos string plist)
+ (when (and string (> (length string) 0))
+ (push (cons pos (cons string plist)) docs-registered)))
+ (display-doc
+ ()
+ (eldoc--handle-docs
+ (mapcar #'cdr
+ (setq docs-registered
+ (sort docs-registered
+ (lambda (a b) (< (car a) (car b))))))))
+ (make-callback
+ (method)
+ (let ((pos (prog1 howmany (cl-incf howmany))))
+ (cl-ecase method
+ (:enthusiast
+ (lambda (string &rest plist)
+ (when (and string (cl-loop for (p) in docs-registered
+ never (< p pos)))
+ (setq docs-registered '())
+ (register-doc pos string plist)
+ (when (and (timerp eldoc--enthusiasm-curbing-timer)
+ (memq eldoc--enthusiasm-curbing-timer
+ timer-list))
+ (cancel-timer eldoc--enthusiasm-curbing-timer))
+ (setq eldoc--enthusiasm-curbing-timer
+ (run-at-time (unless (zerop pos) 0.3)
+ nil #'display-doc)))
+ t))
+ (:patient
+ (cl-incf want)
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (when (zerop (cl-decf want)) (display-doc))
+ t))
+ (:eager
+ (lambda (string &rest plist)
+ (register-doc pos string plist)
+ (display-doc)
+ t))))))
+ (let* ((eldoc--make-callback #'make-callback)
+ (res (funcall eldoc-documentation-strategy)))
+ ;; Observe the old and the new protocol:
+ (cond (;; Old protocol: got string, output immediately;
+ (stringp res) (register-doc 0 res nil) (display-doc))
+ (;; Old protocol: got nil, clear the echo area;
+ (null res) (eldoc--message nil))
+ (;; New protocol: trust callback will be called;
+ t))))))
(defun eldoc-print-current-symbol-info (&optional interactive)
"Document thing at point."
diff --git a/lisp/emacs-lisp/text-property-search.el
b/lisp/emacs-lisp/text-property-search.el
index b6e98f5..61bd98d 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -137,11 +137,19 @@ and if a matching region is found, moves point to its
beginning."
nil)
;; We're standing in the property we're looking for, so find the
;; end.
- ((and (text-property--match-p
- value (get-text-property (1- (point)) property)
- predicate)
- (not not-current))
- (text-property--find-end-backward (1- (point)) property value predicate))
+ ((text-property--match-p
+ value (get-text-property (1- (point)) property)
+ predicate)
+ (let ((origin (point))
+ (match (text-property--find-end-backward
+ (1- (point)) property value predicate)))
+ ;; When we want to ignore the current element, then repeat the
+ ;; search if we haven't moved out of it yet.
+ (if (and not-current
+ (equal (get-text-property (point) property)
+ (get-text-property origin property)))
+ (text-property-search-backward property value predicate)
+ match)))
(t
(let ((origin (point))
(ended nil)
diff --git a/lisp/frame.el b/lisp/frame.el
index 77080b7..081d301 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1083,7 +1083,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(cons (display-buffer-pop-up-frame
buffer (append '((inhibit-same-window . t))
alist))
- 'frame)))
+ 'frame))
+ nil "[other-frame]")
(message "Display next command buffer in a new frame..."))
(defun iconify-or-deiconify-frame ()
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 1ed5000..88873f4 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -603,11 +603,22 @@ manipulated as follows:
(gnus))
;;;###autoload
+(defun gnus-child-unplugged (&optional arg)
+ "Read news as a child unplugged."
+ (interactive "P")
+ (setq gnus-plugged nil)
+ (gnus arg nil 'child))
+
+;;;###autoload
(defun gnus-slave-unplugged (&optional arg)
- "Read news as a slave unplugged."
+ "Read news as a child unplugged."
(interactive "P")
(setq gnus-plugged nil)
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave-unplugged 'gnus-child-unplugged "28.1")
+
+
+
;;;###autoload
(defun gnus-agentize ()
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 614651a..cb20d71 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2303,21 +2303,27 @@ long lines if and only if arg is positive."
"\n")
(put-text-property start (point) 'gnus-decoration 'header)))))
-(defun article-fill-long-lines ()
- "Fill lines that are wider than the window width."
- (interactive)
+(defun article-fill-long-lines (&optional width)
+ "Fill lines that are wider than the window width or `fill-column'.
+If WIDTH (interactively, the numeric prefix), use that as the
+fill width."
+ (interactive "P")
(save-excursion
- (let ((inhibit-read-only t)
- (width (window-width (get-buffer-window (current-buffer)))))
+ (let* ((inhibit-read-only t)
+ (window-width (window-width (get-buffer-window (current-buffer))))
+ (width (if width
+ (prefix-numeric-value width)
+ (min fill-column window-width))))
(save-restriction
(article-goto-body)
(let ((adaptive-fill-mode nil)) ;Why? -sm
(while (not (eobp))
(end-of-line)
- (when (>= (current-column) (min fill-column width))
+ (when (>= (current-column) width)
(narrow-to-region (min (1+ (point)) (point-max))
(point-at-bol))
- (let ((goback (point-marker)))
+ (let ((goback (point-marker))
+ (fill-column width))
(fill-paragraph nil)
(goto-char (marker-position goback)))
(widen))
@@ -4406,6 +4412,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
"e" gnus-article-read-summary-keys
"\C-d" gnus-article-read-summary-keys
+ "\C-c\C-f" gnus-summary-mail-forward
"\M-*" gnus-article-read-summary-keys
"\M-#" gnus-article-read-summary-keys
"\M-^" gnus-article-read-summary-keys
@@ -6674,7 +6681,7 @@ not have a face in `gnus-article-boring-faces'."
(interactive "P")
(gnus-article-check-buffer)
(let ((nosaves
- '("q" "Q" "r" "\C-c\C-f" "m" "a" "f" "WDD" "WDW"
+ '("q" "Q" "r" "m" "a" "f" "WDD" "WDW"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "^" "\M-^" "|"))
(nosave-but-article
@@ -7718,6 +7725,15 @@ positives are possible."
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[
\t\n]+RET\\>"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation
1)
+ ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
+ ("<URL: *\\([^\n<>]*\\)>"
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; RFC 2396 (2.4.3., delims) ...
+ ("\"URL: *\\([^\n\"]*\\)\""
+ 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
+ ;; Raw URLs.
+ (gnus-button-url-regexp
+ 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; The following entries may lead to many false positives so don't enable
;; them by default (use a high button level).
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
@@ -7741,15 +7757,6 @@ positives are possible."
;; Unlike the other regexps we really have to require quoting
;; here to determine where it ends.
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
- ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
- ("<URL: *\\([^\n<>]*\\)>"
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; RFC 2396 (2.4.3., delims) ...
- ("\"URL: *\\([^\n\"]*\\)\""
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; Raw URLs.
- (gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url-button-open-url 0)
;; man pages
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index da7db58..b207c4f 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1129,8 +1129,8 @@ The following commands are available:
(gnus-update-group-mark-positions)
(when gnus-use-undo
(gnus-undo-mode 1))
- (when gnus-slave
- (gnus-slave-mode)))
+ (when gnus-child
+ (gnus-child-mode)))
(defun gnus-update-group-mark-positions ()
(save-excursion
@@ -4024,9 +4024,9 @@ otherwise all levels below ARG will be scanned too."
(gnus-run-hooks 'gnus-get-top-new-news-hook)
(gnus-run-hooks 'gnus-get-new-news-hook)
- ;; Read any slave files.
- (unless gnus-slave
- (gnus-master-read-slave-newsrc))
+ ;; Read any child files.
+ (unless gnus-child
+ (gnus-parent-read-child-newsrc))
(gnus-get-unread-articles (gnus-group-default-level arg t)
nil one-level)
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index 5edbaaf..a772281 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -653,7 +653,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
gnus-options-not-subscribe)
;; Eat all arguments.
(setq command-line-args-left nil)
- (gnus-slave)
+ (gnus-child)
;; Apply kills to specified newsgroups in command line arguments.
(setq newsrc (cdr gnus-newsrc-alist))
(while (setq info (pop newsrc))
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index daaea39..cdfbf16 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1510,7 +1510,11 @@ If YANK is non-nil, include the original article."
(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
(defun gnus-bug (subject)
- "Send a bug report to the Emacs maintainers."
+ "Send a bug report to the Emacs maintainers.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+
https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1";
(interactive "sBug Subject: ")
(report-emacs-bug subject)
(save-excursion
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index f306889..1ac1d05 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -449,19 +449,21 @@ This is not required after changing
`gnus-registry-cache-file'."
to subject sender recipients)))
(defun gnus-registry-spool-action (id group &optional subject sender
recipients)
- (let ((to (gnus-group-guess-full-name-from-command-method group))
- (recipients (or recipients
- (gnus-registry-sort-addresses
- (or (message-fetch-field "cc") "")
- (or (message-fetch-field "to") ""))))
- (subject (or subject (message-fetch-field "subject")))
- (sender (or sender (message-fetch-field "from"))))
- (when (and (stringp id) (string-match "\r$" id))
- (setq id (substring id 0 -1)))
- (gnus-message 7 "Gnus registry: article %s spooled to %s"
- id
- to)
- (gnus-registry-handle-action id nil to subject sender recipients)))
+ (save-restriction
+ (message-narrow-to-headers-or-head)
+ (let ((to (gnus-group-guess-full-name-from-command-method group))
+ (recipients (or recipients
+ (gnus-registry-sort-addresses
+ (or (message-fetch-field "cc") "")
+ (or (message-fetch-field "to") ""))))
+ (subject (or subject (message-fetch-field "subject")))
+ (sender (or sender (message-fetch-field "from"))))
+ (when (and (stringp id) (string-match "\r$" id))
+ (setq id (substring id 0 -1)))
+ (gnus-message 7 "Gnus registry: article %s spooled to %s"
+ id
+ to)
+ (gnus-registry-handle-action id nil to subject sender recipients))))
(defun gnus-registry-handle-action (id from to subject sender
&optional recipients)
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 873923e..78e0749 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -730,7 +730,7 @@ the first newsgroup."
;; Remove Gnus frames.
(gnus-kill-gnus-frames))
-(defun gnus-no-server-1 (&optional arg slave)
+(defun gnus-no-server-1 (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup
level. If ARG is nil, Gnus will be started at level 2
@@ -739,11 +739,11 @@ 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."
(let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
+ (gnus val t child)
(make-local-variable 'gnus-group-use-permanent-levels)
(setq gnus-group-use-permanent-levels val)))
-(defun gnus-1 (&optional arg dont-connect slave)
+(defun gnus-1 (&optional arg dont-connect child)
"Read network news.
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
@@ -761,7 +761,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-splash)
(gnus-run-hooks 'gnus-before-startup-hook)
(nnheader-init-server-buffer)
- (setq gnus-slave slave)
+ (setq gnus-child child)
(gnus-read-init-file)
;; Add "native" to gnus-predefined-server-alist just to have a
@@ -790,7 +790,7 @@ prompt the user for the name of an NNTP server to use."
(gnus-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (when (or gnus-slave gnus-use-dribble-file)
+ (when (or gnus-child gnus-use-dribble-file)
(gnus-dribble-read-file))
;; Do the actual startup.
@@ -1008,11 +1008,11 @@ If LEVEL is non-nil, the news will be set up at level
LEVEL."
;; Possibly eval the dribble file.
(and init
- (or gnus-use-dribble-file gnus-slave)
+ (or gnus-use-dribble-file gnus-child)
(gnus-dribble-eval-file))
- ;; Slave Gnusii should then clear the dribble buffer.
- (when (and init gnus-slave)
+ ;; Child Gnusii should then clear the dribble buffer.
+ (when (and init gnus-child)
(gnus-dribble-clear))
(gnus-update-format-specifications)
@@ -1030,7 +1030,7 @@ If LEVEL is non-nil, the news will be set up at level
LEVEL."
;; Find new newsgroups and treat them.
(when (and init gnus-check-new-newsgroups (not level)
(gnus-check-server gnus-select-method)
- (not gnus-slave)
+ (not gnus-child)
gnus-plugged)
(gnus-find-new-newsgroups))
@@ -1040,8 +1040,8 @@ If LEVEL is non-nil, the news will be set up at level
LEVEL."
(gnus-server-opened gnus-select-method))
(gnus-check-bogus-newsgroups))
- ;; Read any slave files.
- (gnus-master-read-slave-newsrc)
+ ;; Read any child files.
+ (gnus-parent-read-child-newsrc)
;; Find the number of unread articles in each non-dead group.
(let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
@@ -2737,15 +2737,15 @@ values from `gnus-newsrc-hashtb', and write a new value
of
(gnus-agent-save-local force))
(save-excursion
- (if (and (or gnus-use-dribble-file gnus-slave)
+ (if (and (or gnus-use-dribble-file gnus-child)
(not force)
(or (not (buffer-live-p gnus-dribble-buffer))
(zerop (with-current-buffer gnus-dribble-buffer
(buffer-size)))))
(gnus-message 4 "(No changes need to be saved)")
(gnus-run-hooks 'gnus-save-newsrc-hook)
- (if gnus-slave
- (gnus-slave-save-newsrc)
+ (if gnus-child
+ (gnus-child-save-newsrc)
;; Save .newsrc only if the select method is an NNTP method.
;; The .newsrc file is for interoperability with other
;; newsreaders, so saving non-NNTP groups there doesn't make
@@ -2988,55 +2988,61 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
;;;
-;;; Slave functions.
+;;; Child functions.
;;;
-(defvar gnus-slave-mode nil)
+(defvar gnus-child-mode nil)
-(defun gnus-slave-mode ()
- "Minor mode for slave Gnusae."
- ;; FIXME: gnus-slave-mode appears to never be set (i.e. it'll always be nil):
+(defun gnus-child-mode ()
+ "Minor mode for child Gnusae."
+ ;; FIXME: gnus-child-mode appears to never be set (i.e. it'll always be nil):
;; Remove, or fix and use define-minor-mode.
- (add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
- (gnus-run-hooks 'gnus-slave-mode-hook))
+ (add-minor-mode 'gnus-child-mode " Child" (make-sparse-keymap))
+ (gnus-run-hooks 'gnus-child-mode-hook))
-(defun gnus-slave-save-newsrc ()
+(define-obsolete-function-alias 'gnus-slave-mode #'gnus-child-mode "28.1")
+(define-obsolete-variable-alias 'gnus-slave-mode-hook 'gnus-child-mode-hook
+ "28.1")
+
+(defun gnus-child-save-newsrc ()
(with-current-buffer gnus-dribble-buffer
(with-file-modes (or (ignore-errors
(file-modes
(concat gnus-current-startup-file ".eld")))
(default-file-modes))
- (let ((slave-name
- (make-temp-file (concat gnus-current-startup-file "-slave-"))))
+ (let ((child-name
+ (make-temp-file (concat gnus-current-startup-file "-child-"))))
(let ((coding-system-for-write gnus-ding-file-coding-system))
- (gnus-write-buffer slave-name))))))
+ (gnus-write-buffer child-name))))))
-(defun gnus-master-read-slave-newsrc ()
- (let ((slave-files
+(defun gnus-parent-read-child-newsrc ()
+ (let ((child-files
(directory-files
(file-name-directory gnus-current-startup-file)
t (concat
"^" (regexp-quote
- (concat
- (file-name-nondirectory gnus-current-startup-file)
- "-slave-")))
+ (file-name-nondirectory gnus-current-startup-file))
+ ;; When the obsolete variables like
+ ;; `gnus-slave-mode-hook' etc are removed, the "slave"
+ ;; bit of this regexp should also be removed.
+ "\\(-child-\\|-slave-\\)")
t))
file)
- (if (not slave-files)
- () ; There are no slave files to read.
- (gnus-message 7 "Reading slave newsrcs...")
- (with-current-buffer (gnus-get-buffer-create " *gnus slave*")
- (setq slave-files
+ (if (not child-files)
+ () ; There are no child files to read.
+ (gnus-message 7 "Reading child newsrcs...")
+ (with-current-buffer (gnus-get-buffer-create " *gnus child*")
+ (setq child-files
(sort (mapcar (lambda (file)
(list (file-attribute-modification-time
(file-attributes file))
file))
- slave-files)
+ child-files)
(lambda (f1 f2)
(time-less-p (car f1) (car f2)))))
- (while slave-files
+ (while child-files
(erase-buffer)
- (setq file (nth 1 (car slave-files)))
+ (setq file (nth 1 (car child-files)))
(nnheader-insert-file-contents file)
(when (condition-case ()
(progn
@@ -3045,12 +3051,12 @@ SPECIFIC-VARIABLES, or those in `gnus-variable-list'."
(error
(gnus-error 3.2 "Possible error in %s" file)
nil))
- (unless gnus-slave ; Slaves shouldn't delete these files.
+ (unless gnus-child ; Children shouldn't delete these files.
(ignore-errors
(delete-file file))))
- (setq slave-files (cdr slave-files))))
+ (setq child-files (cdr child-files))))
(gnus-dribble-touch)
- (gnus-message 7 "Reading slave newsrcs...done"))))
+ (gnus-message 7 "Reading child newsrcs...done"))))
;;;
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 341f04a..d731893 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -5352,7 +5352,8 @@ or a straight list of headers."
;; We remember that we probably want to output a dummy
;; root.
(setq gnus-tmp-dummy-line gnus-tmp-header)
- (setq gnus-tmp-prev-subject gnus-tmp-header))
+ (setq gnus-tmp-prev-subject
+ (gnus-simplify-subject-fully gnus-tmp-header)))
(t
;; We do not make a root for the gathered
;; sub-threads at all.
@@ -7331,6 +7332,8 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(gnus-group-next-unread-group 1))
(setq group-point (point))
(gnus-article-stop-animations)
+ (unless leave-hidden
+ (gnus-configure-windows 'group 'force))
(if temporary
nil ;Nothing to do.
(set-buffer buf)
@@ -7350,8 +7353,6 @@ If FORCE (the prefix), also save the .newsrc file(s)."
(if quit-config
(gnus-handle-ephemeral-exit quit-config)
(goto-char group-point)
- (unless leave-hidden
- (gnus-configure-windows 'group 'force))
;; If gnus-group-buffer is already displayed, make sure we also move
;; the cursor in the window that displays it.
(let ((win (get-buffer-window (current-buffer) 0)))
@@ -12508,10 +12509,15 @@ save those articles instead."
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
- (list (read-string "Save parts of type: "
- (or (car gnus-summary-save-parts-type-history)
- gnus-summary-save-parts-default-mime)
- 'gnus-summary-save-parts-type-history)
+ (list (completing-read "Save parts of type: "
+ (progn
+ (gnus-summary-select-article nil t)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (delete-dups
+ (mapcar (lambda (h)
+ (mm-handle-media-type (cdr h)))
+ gnus-article-mime-handle-alist))))
+ nil nil nil 'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
(read-directory-name "Save to directory: "
gnus-summary-save-parts-last-directory
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 89d5d12..c411ec7 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -2226,8 +2226,8 @@ Disabling the agent may result in noticeable loss of
performance."
:group 'gnus-start
:type '(choice (function-item gnus)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(declare-function gnus-group-get-new-news "gnus-group")
@@ -2238,8 +2238,8 @@ Disabling the agent may result in noticeable loss of
performance."
:type '(choice (function-item gnus)
(function-item gnus-group-get-new-news)
(function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
+ (function-item gnus-child)
+ (function-item gnus-child-no-server)))
(defcustom gnus-other-frame-parameters nil
"Frame parameters used by `gnus-other-frame' to create a Gnus frame."
@@ -2417,8 +2417,8 @@ such as a mark that says whether an article is stored in
the cache
(defvar gnus-article-buffer "*Article*")
(defvar gnus-server-buffer "*Server*")
-(defvar gnus-slave nil
- "Whether this Gnus is a slave or not.")
+(defvar gnus-child nil
+ "Whether this Gnus is a child or not.")
(defvar gnus-batch-mode nil
"Whether this Gnus is running in batch mode or not.")
@@ -4034,13 +4034,20 @@ Allow completion over sensible values."
;;; User-level commands.
;;;###autoload
+(defun gnus-child-no-server (&optional arg)
+ "Read network news as a child, without connecting to the local server."
+ (interactive "P")
+ (gnus-no-server arg t))
+
+;;;###autoload
(defun gnus-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to the local server."
+ "Read network news as a child, without connecting to the local server."
(interactive "P")
(gnus-no-server arg t))
+(make-obsolete 'gnus-slave-no-server 'gnus-child-no-server "28.1")
;;;###autoload
-(defun gnus-no-server (&optional arg slave)
+(defun gnus-no-server (&optional arg child)
"Read network news.
If ARG is a positive number, Gnus will use that as the startup level.
If ARG is nil, Gnus will be started at level 2. If ARG is non-nil
@@ -4049,13 +4056,20 @@ an NNTP server to use.
As opposed to `gnus', this command will not connect to the local
server."
(interactive "P")
- (gnus-no-server-1 arg slave))
+ (gnus-no-server-1 arg child))
+
+;;;###autoload
+(defun gnus-child (&optional arg)
+ "Read news as a child."
+ (interactive "P")
+ (gnus arg nil 'child))
;;;###autoload
(defun gnus-slave (&optional arg)
- "Read news as a slave."
+ "Read news as a child."
(interactive "P")
- (gnus arg nil 'slave))
+ (gnus arg nil 'child))
+(make-obsolete 'gnus-slave 'gnus-child "28.1")
(defun gnus-delete-gnus-frame ()
"Delete gnus frame unless it is the only one.
@@ -4116,7 +4130,7 @@ current display is used."
(add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame)))))
;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
+(defun gnus (&optional arg dont-connect child)
"Read network news.
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
@@ -4131,7 +4145,7 @@ prompt the user for the name of an NNTP server to use."
(message "You should compile Gnus")
(sit-for 2))
(let ((gnus-action-message-log (list nil)))
- (gnus-1 arg dont-connect slave)
+ (gnus-1 arg dont-connect child)
(gnus-final-warning)))
(declare-function debbugs-gnu "ext:debbugs-gnu"
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 02d9060..a5c8244 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1263,7 +1263,17 @@ If SEND-IF-FORCE, only send authinfo to the server if the
"nntpd" pbuffer nntp-address nntp-port-number
:type (cadr (assoc nntp-open-connection-function map))
:end-of-command "^\\([2345]\\|[.]\\).*\n"
- :capability-command "HELP\r\n"
+ :capability-command
+ (lambda (greeting)
+ (if (and greeting
+ (string-match "Typhoon" greeting))
+ ;; Certain versions of the Typhoon server
+ ;; doesn't understand the CAPABILITIES
+ ;; command, but includes the capability
+ ;; data in the HELP command instead.
+ "HELP\r\n"
+ ;; Use the correct command for everything else.
+ "CAPABILITIES\r\n"))
:success "^3"
:starttls-function
(lambda (capabilities)
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 7f3dc44..efbc066 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -208,7 +208,11 @@ This requires either the macOS \"open\" command, or the
freedesktop
;;;###autoload
(defun report-emacs-bug (topic &optional unused)
"Report a bug in GNU Emacs.
-Prompts for bug subject. Leaves you in a mail buffer."
+Prompts for bug subject. Leaves you in a mail buffer.
+
+Already submitted bugs can be found in the Emacs bug tracker:
+
+
https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1";
(declare (advertised-calling-convention (topic) "24.5"))
(interactive "sBug Subject: ")
;; The syntax `version;' is preferred to `[version]' because the
@@ -270,7 +274,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
'action (lambda (button)
- (browse-url "https://debbugs.gnu.org/";))
+ (browse-url
"https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1";))
'follow-link t)
(insert ". Please check that
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 2f6528d..f4e3aa3 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -263,13 +263,17 @@ This list can be customized via `eww-suggest-uris'."
(nreverse uris)))
;;;###autoload
-(defun eww (url &optional arg)
+(defun eww (url &optional arg buffer)
"Fetch URL and render the page.
If the input doesn't look like an URL or a domain name, the
word(s) will be searched for via `eww-search-prefix'.
If called with a prefix ARG, use a new buffer instead of reusing
-the default EWW buffer."
+the default EWW buffer.
+
+If BUFFER, the data to be rendered is in that buffer. In that
+case, this function doesn't actually fetch URL. BUFFER will be
+killed after rendering."
(interactive
(let* ((uris (eww-suggested-uris))
(prompt (concat "Enter URL or keywords"
@@ -307,8 +311,12 @@ the default EWW buffer."
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url #'eww-render
- (list url nil (current-buffer)))))
+ (if buffer
+ (let ((eww-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (eww-render nil url nil eww-buffer)))
+ (url-retrieve url #'eww-render
+ (list url nil (current-buffer))))))
(function-put 'eww 'browse-url-browser-kind 'internal)
@@ -361,7 +369,19 @@ the default EWW buffer."
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
"/")
- (expand-file-name file))))
+ (expand-file-name file))
+ nil
+ ;; The file name may be a non-local Tramp file. The URL
+ ;; library doesn't understand these file names, so use the
+ ;; normal Emacs machinery to load the file.
+ (with-current-buffer (generate-new-buffer " *eww file*")
+ (set-buffer-multibyte nil)
+ (insert "Content-type: " (or (mailcap-extension-to-mime
+ (url-file-extension file))
+ "application/octet-stream")
+ "\n\n")
+ (insert-file-contents file)
+ (current-buffer))))
;;;###autoload
(defun eww-search-words ()
@@ -1260,7 +1280,7 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-tag-textarea (dom)
(let ((start (point))
- (value (or (dom-attr dom 'value) ""))
+ (value (or (dom-text dom) ""))
(lines (string-to-number (or (dom-attr dom 'rows) "10")))
(width (string-to-number (or (dom-attr dom 'cols) "10")))
end)
@@ -1744,25 +1764,27 @@ If CHARSET is nil then use UTF-8."
(insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
(pp eww-bookmarks (current-buffer))))
-(defun eww-read-bookmarks ()
+(defun eww-read-bookmarks (&optional error-out)
+ "Read bookmarks from `eww-bookmarks'.
+If ERROR-OUT, signal user-error if there are no bookmarks."
(let ((file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)))
(setq eww-bookmarks
(unless (zerop (or (file-attribute-size (file-attributes file)) 0))
(with-temp-buffer
(insert-file-contents file)
- (read (current-buffer)))))))
+ (read (current-buffer)))))
+ (when (and error-out (not eww-bookmarks))
+ (user-error "No bookmarks are defined"))))
;;;###autoload
(defun eww-list-bookmarks ()
"Display the bookmarks."
(interactive)
+ (eww-read-bookmarks t)
(pop-to-buffer "*eww bookmarks*")
(eww-bookmark-prepare))
(defun eww-bookmark-prepare ()
- (eww-read-bookmarks)
- (unless eww-bookmarks
- (user-error "No bookmarks are defined"))
(set-buffer (get-buffer-create "*eww bookmarks*"))
(eww-bookmark-mode)
(let* ((width (/ (window-width) 2))
@@ -1830,6 +1852,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(when (and (not first)
@@ -1848,6 +1871,7 @@ If CHARSET is nil then use UTF-8."
bookmark)
(unless (get-buffer "*eww bookmarks*")
(setq first t)
+ (eww-read-bookmarks t)
(eww-bookmark-prepare))
(with-current-buffer (get-buffer "*eww bookmarks*")
(if first
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 1c371f5..e86426d 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -139,7 +139,10 @@ writes. See `make-network-process' for details.
:capability-command specifies a command used to query the HOST
for its capabilities. For instance, for IMAP this should be
- \"1 CAPABILITY\\r\\n\".
+ \"1 CAPABILITY\\r\\n\". This can either be a string (which will
+ then be sent verbatim to the server), or a function (called with
+ a single parameter; the \"greeting\" from the server when connecting),
+ and should return a string to send to the server.
:starttls-function specifies a function for handling STARTTLS.
This function should take one parameter, the response to the
@@ -280,8 +283,11 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
:coding (plist-get parameters :coding)))
(greeting (and (not (plist-get parameters :nogreeting))
(network-stream-get-response stream start eoc)))
- (capabilities (network-stream-command stream capability-command
- eo-capa))
+ (capabilities
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))
(resulting-type 'plain)
starttls-available starttls-command error)
@@ -329,7 +335,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; Requery capabilities for protocols that require it; i.e.,
;; EHLO for SMTP.
(when (plist-get parameters :always-query-capabilities)
- (network-stream-command stream capability-command eo-capa)))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa)))
(when (let ((response
(network-stream-command stream starttls-command eoc)))
(and response (string-match success-string response)))
@@ -365,7 +374,10 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
host service))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eo-capa))))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(when (and require-tls
@@ -428,7 +440,8 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
parameters)
(require 'tls)
(open-tls-stream name buffer host service)))
- (eoc (plist-get parameters :end-of-command)))
+ (eoc (plist-get parameters :end-of-command))
+ greeting)
(if (plist-get parameters :nowait)
(list stream nil nil 'tls)
;; Check certificate validity etc.
@@ -440,17 +453,22 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
;; openssl/gnutls-cli.
(when (and (not (gnutls-available-p))
eoc)
- (network-stream-get-response stream start eoc)
+ (setq greeting (network-stream-get-response stream start eoc))
(goto-char (point-min))
(when (re-search-forward eoc nil t)
(goto-char (match-beginning 0))
(delete-region (point-min) (line-beginning-position))))
- (let ((capability-command (plist-get parameters :capability-command))
+ (let ((capability-command
+ (plist-get parameters :capability-command))
(eo-capa (or (plist-get parameters :end-of-capability)
eoc)))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eo-capa)
+ (network-stream-command
+ stream
+ (network-stream--capability-command
+ capability-command greeting)
+ eo-capa)
'tls)))))))
(defun network-stream-open-shell (name buffer host service parameters)
@@ -464,21 +482,29 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(format-spec
(plist-get parameters :shell-command)
`((?s . ,host)
- (?p . ,service)))))))
+ (?p . ,service))))))
+ greeting)
(when coding (if (consp coding)
- (set-process-coding-system stream
- (car coding)
- (cdr coding))
(set-process-coding-system stream
- coding
- coding)))
+ (car coding)
+ (cdr coding))
+ (set-process-coding-system stream
+ coding
+ coding)))
(list stream
- (network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command
- (or (plist-get parameters :end-of-capability)
- eoc))
+ (setq greeting (network-stream-get-response stream start eoc))
+ (network-stream-command
+ stream
+ (network-stream--capability-command capability-command greeting)
+ (or (plist-get parameters :end-of-capability)
+ eoc))
'plain)))
+(defun network-stream--capability-command (command greeting)
+ (if (functionp command)
+ (funcall command greeting)
+ command))
+
(provide 'network-stream)
;;; network-stream.el ends here
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index a3f0496..ddd8112 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -95,15 +95,31 @@ If nil, don't draw horizontal table lines."
:type 'character)
(defcustom shr-width nil
- "Frame width to use for rendering.
+ "Window width to use for HTML rendering.
May either be an integer specifying a fixed width in characters,
-or nil, meaning that the full width of the window should be used.
-If `shr-use-fonts' is set, the mean character width is used to
-compute the pixel width, which is used instead."
+or nil, meaning use the full width of the window.
+If `shr-use-fonts' is set, the value is interpreted as a multiple
+of the mean character width of the default face's font.
+
+Also see `shr-max-width'."
:version "25.1"
:type '(choice (integer :tag "Fixed width in characters")
(const :tag "Use the width of the window" nil)))
+(defcustom shr-max-width 120
+ "Maximum text width to use for HTML rendering.
+May either be an integer specifying a fixed width in characters,
+or nil, meaning that there is no width limit.
+
+If `shr-use-fonts' is set, the value of this variable is
+interpreted as a multiple of the mean character width of the
+default face's font.
+
+If `shr-width' is non-nil, it overrides this variable."
+ :version "28.1"
+ :type '(choice (integer :tag "Fixed width in characters")
+ (const :tag "No width limit" nil)))
+
(defcustom shr-bullet "* "
"Bullet used for unordered lists.
Alternative suggestions are:
@@ -267,30 +283,37 @@ DOM should be a parse tree as generated by
(shr-table-separator-pixel-width (shr-string-pixel-width "-"))
(shr-internal-bullet (cons shr-bullet
(shr-string-pixel-width shr-bullet)))
- (shr-internal-width (or (and shr-width
- (if (not shr-use-fonts)
- shr-width
- (* shr-width (frame-char-width))))
- ;; We need to adjust the available
- ;; width for when the user disables
- ;; the fringes, which will cause the
- ;; display engine usurp one column for
- ;; the continuation glyph.
- (if (not shr-use-fonts)
- (- (window-body-width) 1
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- 0
- 1))
- (- (window-body-width nil t)
- (* 2 (frame-char-width))
- (if (and (null shr-width)
- (not (shr--have-one-fringe-p)))
- (* (frame-char-width) 2)
- 0)
- 1))))
+ (shr-internal-width
+ (if shr-width
+ ;; Specified width; use it.
+ (if (not shr-use-fonts)
+ shr-width
+ (* shr-width (frame-char-width)))
+ ;; Compute the width based on the window width. We need to
+ ;; adjust the available width for when the user disables
+ ;; the fringes, which will cause the display engine usurp
+ ;; one column for the continuation glyph.
+ (if (not shr-use-fonts)
+ (- (window-body-width) 1
+ (if (shr--have-one-fringe-p)
+ 1
+ 0))
+ (- (window-body-width nil t)
+ (* 2 (frame-char-width))
+ (if (shr--have-one-fringe-p)
+ 0
+ (* (frame-char-width) 2))
+ 1))))
(max-specpdl-size max-specpdl-size)
bidi-display-reordering)
+ ;; Adjust for max width specification.
+ (when (and shr-max-width
+ (not shr-width))
+ (setq shr-internal-width
+ (min shr-internal-width
+ (if shr-use-fonts
+ (* shr-max-width (frame-char-width))
+ shr-max-width))))
;; If the window was hscrolled for some reason, shr-fill-lines
;; below will misbehave, because it silently assumes that it
;; starts with a non-hscrolled window (vertical-motion will move
@@ -2576,12 +2599,28 @@ flags that control whether to collect or render
objects."
i))
(defun shr-max-columns (dom)
- (let ((max 0))
+ (let ((max 0)
+ (this 0)
+ (rowspans nil))
(dolist (row (dom-children dom))
(when (and (not (stringp row))
(eq (dom-tag row) 'tr))
- (setq max (max max (+ (shr-count row 'td)
- (shr-count row 'th))))))
+ (setq this 0)
+ (dolist (column (dom-children row))
+ (when (and (not (stringp column))
+ (memq (dom-tag column) '(td th)))
+ (setq this (+ 1 this (length rowspans)))
+ ;; We have a rowspan, which we emulate later in rendering
+ ;; by adding an extra column to the following rows.
+ (when-let* ((span (dom-attr column 'rowspan)))
+ (push (string-to-number span) rowspans))))
+ (setq max (max max this)))
+ ;; Count down the rowspans in effect.
+ (let ((new nil))
+ (dolist (span rowspans)
+ (when (> span 1)
+ (push (1- span) new)))
+ (setq rowspans new)))
max))
(provide 'shr)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 25e4097..c1eb36e 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -55,7 +55,7 @@ It is used for TCP/IP devices."
"When this method name is used, forward all calls to Android Debug Bridge.")
;;;###tramp-autoload
-(defcustom tramp-adb-prompt "^[^#\\$]*[#\\$][[:space:]]"
+(defcustom tramp-adb-prompt "^[^#$\n\r]*[#$][[:space:]]"
"Regexp used as prompt in almquist shell."
:type 'regexp
:version "28.1"
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 9df51c1..b88ea0a 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -230,7 +230,7 @@ and apply it if applicable."
(throw 'found t)))))))))
(defvar bug-reference-setup-from-mail-alist
- `((,(regexp-opt '("emacs" "auctex" "gnus") 'words)
+ `((,(regexp-opt '("emacs" "auctex" "gnus" "tramp" "orgmode") 'words)
,(regexp-opt '("@debbugs.gnu.org" "-devel@gnu.org"
;; List-Id of Gnus devel mailing list.
"ding.gnus.org"))
@@ -343,6 +343,65 @@ and set it if applicable."
(push val header-values))))))
(bug-reference--maybe-setup-from-mail nil header-values)))))))
+(defvar bug-reference-setup-from-irc-alist
+ `((,(concat "#" (regexp-opt '("emacs" "gnus" "org-mode" "rcirc"
+ "erc") 'words))
+ "freenode"
+ "\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)"
+ "https://debbugs.gnu.org/%s";))
+ "An alist for setting up `bug-reference-mode' in IRC modes.
+
+This takes action if `bug-reference-mode' is enabled in IRC
+channels using one of Emacs' IRC clients (rcirc and ERC).
+Currently, only rcirc is supported.
+
+Each element has the form
+
+ (CHANNEL-REGEXP SERVER-REGEXP BUG-REGEXP URL-FORMAT)
+
+CHANNEL-REGEXP is a regexp matched against the current mail IRC
+channel name. SERVER-REGEXP is matched against the IRC server
+name. If any of those matches, BUG-REGEXP is set as
+`bug-reference-bug-regexp' and URL-FORMAT is set as
+`bug-reference-url-format'.")
+
+(defun bug-reference--maybe-setup-from-irc (channel server)
+ "Set up according to IRC CHANNEL or SERVER.
+CHANNEL is an IRC channel name and SERVER is that channel's
+server name.
+
+If any CHANNEL-REGEXP or SERVER-REGEXP of
+`bug-reference-setup-from-irc-alist' matches CHANNEL or SERVER,
+the corresponding BUG-REGEXP and URL-FORMAT are set."
+ (catch 'setup-done
+ (dolist (config bug-reference-setup-from-irc-alist)
+ (when (or
+ (and channel
+ (car config)
+ (string-match-p (car config) channel))
+ (and server
+ (nth 1 config)
+ (string-match-p (car config) server)))
+ (setq-local bug-reference-bug-regexp (nth 2 config))
+ (setq-local bug-reference-url-format (nth 3 config))
+ (throw 'setup-done t)))))
+
+(defvar rcirc-target)
+(defvar rcirc-server-buffer)
+(defvar rcirc-server)
+
+(defun bug-reference-try-setup-from-rcirc ()
+ "Try setting up `bug-reference-mode' based on rcirc channel and server.
+Test each configuration in `bug-reference-setup-from-irc-alist'
+and set it if applicable."
+ (when (derived-mode-p 'rcirc-mode)
+ (bug-reference--maybe-setup-from-irc
+ rcirc-target
+ (and rcirc-server-buffer
+ (buffer-live-p rcirc-server-buffer)
+ (with-current-buffer rcirc-server-buffer
+ rcirc-server)))))
+
(defun bug-reference--run-auto-setup ()
(when (or bug-reference-mode
bug-reference-prog-mode)
@@ -354,7 +413,8 @@ and set it if applicable."
"Error during bug-reference auto-setup: %S"
(catch 'setup
(dolist (f (list #'bug-reference-try-setup-from-vc
- #'bug-reference-try-setup-from-gnus))
+ #'bug-reference-try-setup-from-gnus
+ #'bug-reference-try-setup-from-rcirc))
(when (funcall f)
(throw 'setup t))))))))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 92c1ce8..81bcd10 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -2337,68 +2337,48 @@ Note that this is a strict tail, so won't match, e.g.
\"0x....\".")
;; line was fouled up by context fontification.
(save-restriction
(widen)
- (let (new-beg new-end new-region case-fold-search string-fence-beg lim)
- ;; Check how far back we need to extend the region where we reapply the
- ;; string fence syntax-table properties. These must be in place for the
- ;; coming fontification operations.
- (save-excursion
- (goto-char (if c-in-after-change-fontification
- (min beg c-new-BEG)
- beg))
- (setq lim (max (- (point) 500) (point-min)))
- (while
+ (let (new-beg new-end new-region case-fold-search)
+ (c-save-buffer-state nil
+ ;; Temporarily reapply the string fence syntax-table properties.
+ (unwind-protect
(progn
- (skip-chars-backward "^\"" lim)
- (or (bobp) (backward-char))
- (save-excursion
- (eq (logand (skip-chars-backward "\\\\") 1) 1))))
- (setq string-fence-beg
- (cond ((c-get-char-property (point) 'c-fl-syn-tab)
- (point))
- (c-in-after-change-fontification
- c-new-BEG)
- (t beg)))
- (c-save-buffer-state nil
- ;; Temporarily reapply the string fence syntax-table properties.
- (unwind-protect
- (progn
- (c-restore-string-fences)
- (if (and c-in-after-change-fontification
- (< beg c-new-END) (> end c-new-BEG))
- ;; Region and the latest after-change fontification region
overlap.
- ;; Determine the upper and lower bounds of our adjusted
region
- ;; separately.
- (progn
- (if (<= beg c-new-BEG)
- (setq c-in-after-change-fontification nil))
- (setq new-beg
- (if (and (>= beg (c-point 'bol c-new-BEG))
- (<= beg c-new-BEG))
- ;; Either jit-lock has accepted `c-new-BEG', or
has
- ;; (probably) extended the change region
spuriously
- ;; to BOL, which position likely has a
- ;; syntactically different position. To ensure
- ;; correct fontification, we start at
`c-new-BEG',
- ;; assuming any characters to the left of
- ;; `c-new-BEG' on the line do not require
- ;; fontification.
- c-new-BEG
- (setq new-region
(c-before-context-fl-expand-region beg end)
- new-end (cdr new-region))
- (car new-region)))
- (setq new-end
- (if (and (>= end (c-point 'bol c-new-END))
- (<= end c-new-END))
- c-new-END
- (or new-end
- (cdr (c-before-context-fl-expand-region beg
end))))))
- ;; Context (etc.) fontification.
- (setq new-region (c-before-context-fl-expand-region beg end)
- new-beg (car new-region) new-end (cdr new-region)))
- ;; Finally invoke font lock's functionality.
- (funcall (default-value 'font-lock-fontify-region-function)
- new-beg new-end verbose))
- (c-clear-string-fences)))))))
+ (c-restore-string-fences)
+ (if (and c-in-after-change-fontification
+ (< beg c-new-END) (> end c-new-BEG))
+ ;; Region and the latest after-change fontification region
overlap.
+ ;; Determine the upper and lower bounds of our adjusted region
+ ;; separately.
+ (progn
+ (if (<= beg c-new-BEG)
+ (setq c-in-after-change-fontification nil))
+ (setq new-beg
+ (if (and (>= beg (c-point 'bol c-new-BEG))
+ (<= beg c-new-BEG))
+ ;; Either jit-lock has accepted `c-new-BEG', or
has
+ ;; (probably) extended the change region
spuriously
+ ;; to BOL, which position likely has a
+ ;; syntactically different position. To ensure
+ ;; correct fontification, we start at `c-new-BEG',
+ ;; assuming any characters to the left of
+ ;; `c-new-BEG' on the line do not require
+ ;; fontification.
+ c-new-BEG
+ (setq new-region (c-before-context-fl-expand-region
beg end)
+ new-end (cdr new-region))
+ (car new-region)))
+ (setq new-end
+ (if (and (>= end (c-point 'bol c-new-END))
+ (<= end c-new-END))
+ c-new-END
+ (or new-end
+ (cdr (c-before-context-fl-expand-region beg
end))))))
+ ;; Context (etc.) fontification.
+ (setq new-region (c-before-context-fl-expand-region beg end)
+ new-beg (car new-region) new-end (cdr new-region)))
+ ;; Finally invoke font lock's functionality.
+ (funcall (default-value 'font-lock-fontify-region-function)
+ new-beg new-end verbose))
+ (c-clear-string-fences))))))
(defun c-after-font-lock-init ()
;; Put on `font-lock-mode-hook'. This function ensures our after-change
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 67ce3dc..db8e54b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -91,6 +91,7 @@
;;; Code:
(require 'cl-generic)
+(require 'seq)
(eval-when-compile (require 'subr-x))
(defgroup project nil
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 04f4bca..cee88cb 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1581,7 +1581,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(display-buffer-in-tab
buffer (append alist '((inhibit-same-window . nil))))
(selected-window))
- 'tab)))
+ 'tab))
+ nil "[other-tab]")
(message "Display next command buffer in a new tab..."))
(define-key tab-prefix-map "2" 'tab-new)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 669c245..8532da1 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -702,15 +702,7 @@ should be shown to the user."
;; Treat everything like '300'
nil))
(when redirect-uri
- ;; Clean off any whitespace and/or <...> cruft.
- (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
- (if (string-match "^<\\(.*\\)>$" redirect-uri)
- (setq redirect-uri (match-string 1 redirect-uri)))
-
- ;; Some stupid sites (like sourceforge) send a
- ;; non-fully-qualified URL (ie: /), which royally confuses
- ;; the URL library.
+ ;; Handle relative redirect URIs.
(if (not (string-match url-nonrelative-link redirect-uri))
;; Be careful to use the real target URL, otherwise we may
;; compute the redirection relative to the URL of the proxy.
@@ -1404,13 +1396,22 @@ The return value of this function is the retrieval
buffer."
(defun url-https-proxy-connect (connection)
(setq url-http-after-change-function 'url-https-proxy-after-change-function)
- (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
- "Host: %s\r\n"
- "\r\n")
- (url-host url-current-object)
- (or (url-port url-current-object)
- url-https-default-port)
- (url-host url-current-object))))
+ (process-send-string
+ connection
+ (format
+ (concat "CONNECT %s:%d HTTP/1.1\r\n"
+ "Host: %s\r\n"
+ (let ((proxy-auth (let ((url-basic-auth-storage
+ 'url-http-proxy-basic-auth-storage))
+ (url-get-authentication url-http-proxy nil
+ 'any nil))))
+ (and proxy-auth
+ (concat "Proxy-Authorization: " proxy-auth "\r\n")))
+ "\r\n")
+ (url-host url-current-object)
+ (or (url-port url-current-object)
+ url-https-default-port)
+ (url-host url-current-object))))
(defun url-https-proxy-after-change-function (_st _nd _length)
(let* ((process-buffer (current-buffer))
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index ff18cf1..46cdff0 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -123,17 +123,24 @@ The variable `url-queue-timeout' sets a timeout."
(setq url-queue-progress-timer nil))))
(defun url-queue-callback-function (status job)
- (setq url-queue (delq job url-queue))
- (when (and (eq (car status) :error)
- (eq (cadr (cadr status)) 'connection-failed))
- ;; If we get a connection error, then flush all other jobs from
- ;; the host from the queue. This particularly makes sense if the
- ;; error really is a DNS resolver issue, which happens
- ;; synchronously and totally halts Emacs.
- (url-queue-remove-jobs-from-host
- (plist-get (nthcdr 3 (cadr status)) :host)))
- (url-queue-run-queue)
- (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))
+ (let ((buffer (current-buffer)))
+ (setq url-queue (delq job url-queue))
+ (when (and (eq (car status) :error)
+ (eq (cadr (cadr status)) 'connection-failed))
+ ;; If we get a connection error, then flush all other jobs from
+ ;; the host from the queue. This particularly makes sense if the
+ ;; error really is a DNS resolver issue, which happens
+ ;; synchronously and totally halts Emacs.
+ (url-queue-remove-jobs-from-host
+ (plist-get (nthcdr 3 (cadr status)) :host)))
+ (url-queue-run-queue)
+ ;; Somehow something deep in the bowels in the URL library may
+ ;; have killed off the current buffer. So check that it's still
+ ;; alive before doing anything, and if not, just create a dummy
+ ;; buffer and do the callback anyway.
+ (unless (buffer-live-p buffer)
+ (set-buffer (generate-new-buffer " *temp*")))
+ (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))))
(defun url-queue-remove-jobs-from-host (host)
(let ((jobs nil))
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 341c739..6557960 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -491,8 +491,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(cons window type)))
(lambda (old-window new-window)
(when (window-live-p (if no-select old-window new-window))
- (select-window (if no-select old-window new-window))))))
- (message "[display-%s]" dir))
+ (select-window (if no-select old-window new-window))))
+ (format "[display-%s]" dir))))
;;;###autoload
(defun windmove-display-left (&optional arg)
diff --git a/lisp/window.el b/lisp/window.el
index 675aff0..f20940f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -4021,7 +4021,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(setq type 'window)
(setq window (display-buffer-use-some-window buffer alist)
type 'reuse))
- (cons window type))))
+ (cons window type)))
+ nil "[other-window]")
(message "Display next command buffer in a new window..."))
(defun same-window-prefix ()
@@ -4039,7 +4040,8 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(cons (or
(display-buffer-same-window buffer alist)
(display-buffer-use-some-window buffer alist))
- 'reuse)))
+ 'reuse))
+ nil "[same-window]")
(message "Display next command buffer in the same window..."))
;; This should probably return non-nil when the selected window is part
@@ -8616,14 +8618,16 @@ documentation for additional customization information."
(list (read-buffer-to-switch "Switch to buffer in other frame: ")))
(pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
-(defun display-buffer-override-next-command (pre-function &optional
post-function)
+(defun display-buffer-override-next-command (pre-function &optional
post-function echo)
"Set `display-buffer-overriding-action' for the next command.
`pre-function' is called to prepare the window where the buffer should be
displayed. This function takes two arguments `buffer' and `alist', and
should return a cons with the displayed window and its type. See the
meaning of these values in `window--display-buffer'.
Optional `post-function' is called after the buffer is displayed in the
-window; the function takes two arguments: an old and new window."
+window; the function takes two arguments: an old and new window.
+Optional string argument `echo' can be used to add a prefix to the
+command echo keystrokes that should describe the current prefix state."
(let* ((old-window (or (minibuffer-selected-window) (selected-window)))
(new-window nil)
(minibuffer-depth (minibuffer-depth))
@@ -8641,11 +8645,13 @@ window; the function takes two arguments: an old and
new window."
(setq post-function nil)
new-window))))
(command this-command)
+ (echofun (when echo (lambda () echo)))
(exitfun
(lambda ()
(setcar display-buffer-overriding-action
(delq action (car display-buffer-overriding-action)))
(remove-hook 'post-command-hook clearfun)
+ (remove-hook 'prefix-command-echo-keystrokes-functions echofun)
(when (functionp post-function)
(funcall post-function old-window new-window)))))
(fset clearfun
@@ -8661,6 +8667,8 @@ window; the function takes two arguments: an old and new
window."
;; Reset display-buffer-overriding-action
;; after the next command finishes
(add-hook 'post-command-hook clearfun)
+ (when echofun
+ (add-hook 'prefix-command-echo-keystrokes-functions echofun))
(push action (car display-buffer-overriding-action))))
diff --git a/src/image.c b/src/image.c
index c8a192a..e7e0a93 100644
--- a/src/image.c
+++ b/src/image.c
@@ -8274,7 +8274,10 @@ gif_load (struct frame *f, struct image *img)
rc = DGifSlurp (gif);
if (rc == GIF_ERROR || gif->ImageCount <= 0)
{
- image_error ("Error reading `%s'", img->spec);
+ if (NILP (specified_data))
+ image_error ("Error reading `%s'", img->spec);
+ else
+ image_error ("Error reading GIF data");
gif_close (gif, NULL);
return 0;
}