[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master bdda935 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/g
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master bdda935 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs |
|
Date: |
Sun, 16 Aug 2020 14:26:00 -0400 (EDT) |
branch: master
commit bdda935a7d9519b71822270cf98328ae236b257d
Merge: ada0b9b df2ae3f
Author: Lars Ingebrigtsen <larsi@openbsd6.gnus.org>
Commit: Lars Ingebrigtsen <larsi@openbsd6.gnus.org>
Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs
---
admin/release-process | 8 +-
configure.ac | 26 ++++++-
doc/emacs/fixit.texi | 10 ++-
doc/emacs/maintaining.texi | 5 +-
doc/emacs/misc.texi | 4 +-
doc/lispref/searching.texi | 2 +-
doc/misc/gnus.texi | 8 +-
etc/NEWS | 65 ++++++++++++++--
lisp/cus-edit.el | 23 +++---
lisp/doc-view.el | 29 +++++++
lisp/erc/erc-match.el | 67 ++++++++++------
lisp/eshell/esh-mode.el | 75 +++++++++---------
lisp/ffap.el | 133 +++++++++++++++++++++++++++++++-
lisp/gnus/gnus-sum.el | 3 +-
lisp/ido.el | 6 +-
lisp/mail/flow-fill.el | 36 +++++----
lisp/mwheel.el | 29 +++----
lisp/net/eudc-bob.el | 130 +++++++++++--------------------
lisp/net/ntlm.el | 44 +++++------
lisp/progmodes/compile.el | 5 +-
lisp/progmodes/elisp-mode.el | 10 ++-
lisp/progmodes/perl-mode.el | 4 +-
lisp/progmodes/project.el | 22 +-----
lisp/progmodes/subword.el | 2 +
lisp/progmodes/xref.el | 43 ++++++++---
lisp/subr.el | 3 +-
lisp/term.el | 14 +++-
lisp/textmodes/flyspell.el | 61 ++++++---------
lisp/url/url-expand.el | 2 +-
lisp/vc/diff-mode.el | 2 +-
src/ccl.c | 11 +--
src/charset.c | 9 +--
src/coding.c | 9 +--
src/composite.c | 2 +-
src/fns.c | 30 +++----
src/font.c | 74 ++++++++----------
src/fontset.c | 27 +++----
src/ftfont.c | 12 +--
src/hbfont.c | 11 +--
src/lisp.h | 18 +++--
src/macfont.m | 6 +-
src/nsselect.m | 2 +-
src/nsxwidget.m | 4 +-
src/pdumper.c | 32 +++++---
src/search.c | 13 +---
src/syntax.c | 4 +-
src/window.c | 2 +-
src/xdisp.c | 4 +-
src/xfaces.c | 28 +++----
src/xfns.c | 8 +-
src/xselect.c | 6 +-
src/xwidget.c | 4 +-
test/lisp/ffap-tests.el | 40 ++++++++++
test/lisp/mail/flow-fill-tests.el | 3 +-
test/lisp/progmodes/cperl-mode-tests.el | 25 +++---
test/lisp/url/url-expand-tests.el | 7 ++
test/src/fns-tests.el | 6 ++
57 files changed, 756 insertions(+), 512 deletions(-)
diff --git a/admin/release-process b/admin/release-process
index 1ed7a2e..b8587e6 100644
--- a/admin/release-process
+++ b/admin/release-process
@@ -192,16 +192,14 @@ sk Miroslav Vaško
** Check for modes which bind M-s that conflicts with a new global binding M-s
and change key bindings where necessary. The current list of modes:
-1. Gnus binds 'M-s' to 'gnus-summary-search-article-forward'.
-
-2. Minibuffer binds 'M-s' to 'next-matching-history-element'
+1. Minibuffer binds 'M-s' to 'next-matching-history-element'
(not useful any more since C-s can now search in the history).
-3. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to
+2. PCL-CVS binds 'M-s' to 'cvs-status', and log-edit-mode binds it to
'log-edit-comment-search-forward'. Perhaps search commands
on the global key binding 'M-s' are useless in these modes.
-4. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'.
+3. Rmail binds '\es' to 'rmail-search'/'rmail-summary-search'.
* DOCUMENTATION
diff --git a/configure.ac b/configure.ac
index 7ce64f7..745ff22 100644
--- a/configure.ac
+++ b/configure.ac
@@ -219,6 +219,21 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl
m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=no])dnl
])dnl
+dnl OPTION_DEFAULT_IFAVAILABLE(NAME, HELP-STRING)
+dnl Create a new --with option that defaults to 'ifavailable'.
+dnl NAME is the base name of the option. The shell variable with_NAME
+dnl will be set to either the user's value (if the option is
+dnl specified; 'yes' for a plain --with-NAME) or to 'ifavailable' (if the
+dnl option is not specified). Note that the shell variable name is
+dnl constructed as autoconf does, by replacing non-alphanumeric
+dnl characters with "_".
+dnl HELP-STRING is the help text for the option.
+AC_DEFUN([OPTION_DEFAULT_IFAVAILABLE], [dnl
+ AC_ARG_WITH([$1],[AS_HELP_STRING([--with-$1],[$2])],[],[dnl
+ m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=ifavailable])dnl
+])dnl
+
+
dnl OPTION_DEFAULT_ON(NAME, HELP-STRING)
dnl Create a new --with option that defaults to $with_features.
dnl NAME is the base name of the option. The shell variable with_NAME
@@ -438,7 +453,7 @@ OPTION_DEFAULT_ON([cairo],[don't compile with Cairo
drawing])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support])
OPTION_DEFAULT_ON([native-image-api], [don't use native image APIs (GDI+ on
Windows)])
-OPTION_DEFAULT_ON([json], [don't compile with native JSON support])
+OPTION_DEFAULT_IFAVAILABLE([json], [don't compile with native JSON support])
OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts])
OPTION_DEFAULT_ON([harfbuzz],[don't use HarfBuzz for text shaping])
@@ -708,7 +723,7 @@ case "${canonical}" in
*-apple-darwin* )
case "${canonical}" in
*-apple-darwin[0-9].*) unported=yes ;;
- i[3456]86-* | x86_64-* ) ;;
+ i[3456]86-* | x86_64-* | arm-* ) ;;
* ) unported=yes ;;
esac
opsys=darwin
@@ -2926,7 +2941,7 @@ AC_SUBST(LIBSYSTEMD_CFLAGS)
HAVE_JSON=no
JSON_OBJ=
-if test "${with_json}" = yes; then
+if test "${with_json}" != no; then
EMACS_CHECK_MODULES([JSON], [jansson >= 2.7],
[HAVE_JSON=yes], [HAVE_JSON=no])
if test "${HAVE_JSON}" = yes; then
@@ -3877,6 +3892,11 @@ case $with_gnutls,$HAVE_GNUTLS in
*) MISSING="$MISSING gnutls"
WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-gnutls=ifavailable";;
esac
+case $with_json,$HAVE_JSON in
+ no,* | ifavailable,* | *,yes) ;;
+ *) MISSING="$MISSING json"
+ WITH_IFAVAILABLE="$WITH_IFAVAILABLE --with-json=ifavailable";;
+esac
if test "X${MISSING}" != X; then
AC_MSG_ERROR([The following required libraries were not found:
$MISSING
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 5046146..507e780 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -445,12 +445,14 @@ use @code{flyspell-region} or @code{flyspell-buffer} for
that.
@findex flyspell-correct-word-before-point
When Flyspell mode highlights a word as misspelled, you can click on
it with @kbd{mouse-2} (@code{flyspell-correct-word}) to display a menu
-of possible corrections and actions. In addition, @kbd{C-.} or
+of possible corrections and actions. If you want this menu on
+@kbd{mouse-3} instead, customize the variable
+@code{flyspell-correct-on-mouse-3}. In addition, @kbd{C-.} or
@kbd{@key{ESC}-@key{TAB}} (@code{flyspell-auto-correct-word}) will
propose various successive corrections for the word at point, and
-@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop up a
-menu of possible corrections. Of course, you can always correct the
-misspelled word by editing it manually in any way you like.
+@w{@kbd{C-c $}} (@code{flyspell-correct-word-before-point}) will pop
+up a menu of possible corrections. Of course, you can always correct
+the misspelled word by editing it manually in any way you like.
@findex flyspell-prog-mode
Flyspell Prog mode works just like ordinary Flyspell mode, except
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 43ec2d4..9f550b4 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1793,13 +1793,12 @@ for a buffer to switch and considering only the current
project's
buffers as candidates for completion.
@findex project-kill-buffers
-@vindex project-kill-buffers-ignores
+@vindex project-kill-buffer-conditions
When you finish working on the project, you may wish to kill all the
buffers that belong to the project, to keep your Emacs session
smaller. The command @kbd{C-x p k} (@code{project-kill-buffers})
accomplishes that: it kills all the buffers that belong to the current
-project, except if @code{project-kill-buffers-ignores} tells
-otherwise.
+project that satisfy any of @code{project-kill-buffer-conditions}.
@node Switching Projects
@subsection Switching Projects
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index f3c9d76..317a197 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -245,13 +245,13 @@ Do an incremental search on the selected article buffer
(@code{gnus-summary-isearch-article}), as if you switched to the
buffer and typed @kbd{C-s} (@pxref{Incremental Search}).
-@kindex M-s @r{(Gnus Summary mode)}
+@kindex M-s M-s @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-forward
@item M-s @var{regexp} @key{RET}
Search forward for articles containing a match for @var{regexp}
(@code{gnus-summary-search-article-forward}).
-@kindex M-r @r{(Gnus Summary mode)}
+@kindex M-s M-r @r{(Gnus Summary mode)}
@findex gnus-summary-search-article-backward
@item M-r @var{regexp} @key{RET}
Search back for articles containing a match for @var{regexp}
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index c8a12bd..b6242c5 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -342,7 +342,7 @@ this choice, the rest of the regexp matches successfully.
long time, if they lead to ambiguous matching. For
example, trying to match the regular expression @samp{\(x+y*\)*a}
against the string @samp{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz} could
-take hours before it ultimately fails. Emacs must try each way of
+take hours before it ultimately fails. Emacs may try each way of
grouping the @samp{x}s before concluding that none of them can work.
In general, avoid expressions that can match the same string in
multiple ways.
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 584c546..332926a 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -11029,14 +11029,14 @@ Go to the Gnus info node (@code{gnus-info-find-node}).
@table @kbd
-@item M-s
-@kindex M-s @r{(Summary)}
+@item M-s M-s
+@kindex M-s M-s @r{(Summary)}
@findex gnus-summary-search-article-forward
Search through all subsequent (raw) articles for a regexp
(@code{gnus-summary-search-article-forward}).
-@item M-r
-@kindex M-r @r{(Summary)}
+@item M-s M-r
+@kindex M-s M-r @r{(Summary)}
@findex gnus-summary-search-article-backward
Search through all previous (raw) articles for a regexp
(@code{gnus-summary-search-article-backward}).
diff --git a/etc/NEWS b/etc/NEWS
index 91add02..3f52d26 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -262,6 +262,13 @@ invoke 'C-u C-x v s' ('vc-create-tag').
** Gnus
++++
+*** The key binding of 'gnus-summary-search-article-forward' has changed.
+This command was previously on 'M-s' and shadowed the global 'M-s'
+search prefix. The command has now been moved to 'M-s M-s'. (For
+consistency, the 'M-s M-r' key binding has been added for the
+'gnus-summary-search-article-backward' command.)
+
---
*** The value of "all" in the 'large-newsgroup-initial' group parameter
changes.
It was previously nil, which didn't work, because nil is
@@ -726,6 +733,13 @@ Italic text is displayed in the new 'erc-italic-face'.
This file contained ERC compatibility code for Emacs 21 and XEmacs
which is no longer needed.
+---
+*** erc-match.el now supports 'message' highlight type (not including the
nick).
+The 'erc-current-nick-highlight-type', 'erc-pal-highlight-type',
+'erc-fool-highlight-type', 'erc-keyword-highlight-type', and
+'erc-dangerous-host-highlight-type' variables now support a 'message'
+type for highlighting the entire message but not the sender's nick.
+
** Battery
---
@@ -783,13 +797,7 @@ work more traditionally, with 'C-d' deleting the next
character.
Likewise, point isn't moved to the end of the string before inserting
digits.
-** Miscellaneous
-
----
-*** 'icomplete-show-matches-on-no-input' behavior change
-Previously, choosing a different completion with commands like 'C-.'
-and then hitting enter would choose the default completion. Doung
-this will now choose the completion under point.
+** term-mode
---
*** New user option 'term-scroll-snap-to-bottom'.
@@ -797,6 +805,39 @@ By default, 'term' and 'ansi-term' will now recenter the
buffer so
that the prompt is on the final line in the window. Setting this new
user option to nil inhibits this behavior.
+---
+*** New user option 'term-set-terminal-size'
+If non-nil, the LINES and COLUMNS environment variables will be set
+based on the current window size. In previous versions of Emacs, this
+was always done (and that could lead to odd displays when resizing the
+window after starting). This variable defaults to nil.
+
+
+** Miscellaneous
+
+---
+*** Killing virtual ido buffers interactively will make them go away.
+Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't
+do anything. This has now been changed, and killing virtual buffers
+with that command will remove the buffer from recentf.
+
+---
+*** New variable 'ffap-file-name-with-spaces'.
+If non-nil, 'find-file-at-point' and friends will try to guess more
+expansively to identify a file name with spaces.
+
+---
+*** Two new commands for centering in 'doc-view-mode'.
+The new commands 'doc-view-center-page-horizontally' (bound to 'c h')
+and 'doc-view-center-page-vertically' (bound to 'c v') center the page
+horizontally and vertically, respectively.
+
+---
+*** Change in meaning of 'icomplete-show-matches-on-no-input'.
+Previously, choosing a different completion with commands like 'C-.'
+and then hitting RET would choose the default completion. Doing this
+will now choose the completion under point instead.
+
*** The new library hierarchy.el has been added.
It's a library to create, query, navigate and display hierarchy
structures.
@@ -834,6 +875,16 @@ height of lines or width of chars.
When non-nil, use a new xwidget webkit session after bookmark jump.
Otherwise, it will use 'xwidget-webkit-last-session'.
+** Flyspell mode
+
++++
+*** Corrections and actions menu can be optionally bound to mouse-3.
+When Flyspell mode highlights a word as misspelled, you can click on
+it to display a menu of possible corrections and actions. You can now
+easily bind this menu to mouse-3 (usually the right mouse button)
+instead of mouse-2 (the default) by customizing the new option
+'flyspell-correct-on-mouse-3'.
+
* New Modes and Packages in Emacs 28.1
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 5ec5799..23ceb3a 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -801,16 +801,19 @@ has been executed, nil otherwise."
If a setting was edited and set before, this saves it. If a
setting was merely edited before, this sets it then saves it."
(interactive)
- (when (custom-command-apply
- (lambda (child)
- (when (memq (widget-get child :custom-state)
- '(modified set changed rogue))
- (widget-apply child :custom-mark-to-save)))
- "Save all settings in this buffer? " t)
- ;; Save changes to buffer and redraw.
- (custom-save-all)
- (dolist (child custom-options)
- (widget-apply child :custom-state-set-and-redraw))))
+ (let (edited-widgets)
+ (when (custom-command-apply
+ (lambda (child)
+ (when (memq (widget-get child :custom-state)
+ '(modified set changed rogue))
+ (push child edited-widgets)
+ (widget-apply child :custom-mark-to-save)))
+ "Save all settings in this buffer? " t)
+ ;; Save changes to buffer.
+ (custom-save-all)
+ ;; Redraw and recalculate the state when necessary.
+ (dolist (widget edited-widgets)
+ (widget-apply widget :custom-state-set-and-redraw)))))
(defun custom-reset (_widget &optional event)
"Select item from reset menu."
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 3e2b244..77c06a8 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -435,6 +435,9 @@ Typically \"page-%s.png\".")
(define-key map (kbd "c m") 'doc-view-set-slice-using-mouse)
(define-key map (kbd "c b") 'doc-view-set-slice-from-bounding-box)
(define-key map (kbd "c r") 'doc-view-reset-slice)
+ ;; Centering the image
+ (define-key map (kbd "c h") 'doc-view-center-page-horizontally)
+ (define-key map (kbd "c v") 'doc-view-center-page-vertically)
;; Searching
(define-key map (kbd "C-s") 'doc-view-search)
(define-key map (kbd "<find>") 'doc-view-search)
@@ -921,6 +924,32 @@ Resize the containing frame if needed."
(when new-frame-params
(modify-frame-parameters (selected-frame) new-frame-params))))
+(defun doc-view-center-page-horizontally ()
+ "Center page horizontally when page is wider than window."
+ (interactive)
+ (let ((page-width (car (image-size (doc-view-current-image) 'pixel)))
+ (window-width (window-body-width nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-hscroll 0)
+ ;; How many pixels are there in a column?
+ (col-in-pixel (/ (window-body-width nil 'pixel)
+ (window-body-width nil))))
+ (when (> page-width window-width)
+ (setq pixel-hscroll (/ (- page-width window-width) 2))
+ (set-window-hscroll (selected-window)
+ (/ pixel-hscroll col-in-pixel)))))
+
+(defun doc-view-center-page-vertically ()
+ "Center page vertically when page is wider than window."
+ (interactive)
+ (let ((page-height (cdr (image-size (doc-view-current-image) 'pixel)))
+ (window-height (window-body-height nil 'pixel))
+ ;; How much do we scroll in order to center the page?
+ (pixel-scroll 0))
+ (when (> page-height window-height)
+ (setq pixel-scroll (/ (- page-height window-height) 2))
+ (set-window-vscroll (selected-window) pixel-scroll 'pixel))))
+
(defun doc-view-reconvert-doc ()
"Reconvert the current document.
Should be invoked when the cached images aren't up-to-date."
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 6e87a18..b314567 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -94,7 +94,9 @@ The following values are allowed:
`nick-or-keyword' - highlight the nick of the user who typed your nickname,
or all instances of the current nickname if there was
no sending user
- `all' - highlight the entire message where current nickname occurs
+ `message' - highlight the entire message where current nickname occurs
+ `all' - highlight the entire message (including the nick) where
+ current nickname occurs
Any other value disables highlighting of current nickname altogether."
:group 'erc-match
@@ -102,6 +104,7 @@ Any other value disables highlighting of current nickname
altogether."
(const nick)
(const keyword)
(const nick-or-keyword)
+ (const message)
(const all)))
(defcustom erc-pal-highlight-type 'nick
@@ -110,14 +113,17 @@ See `erc-pals'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight pal's nickname only
- `all' - highlight the entire message from pal
+ nil - do not highlight the message at all
+ `nick' - highlight pal's nickname only
+ `message' - highlight the entire message from pal
+ `all' - highlight the entire message (including the nick)
+ from pal
Any other value disables pal highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-fool-highlight-type 'nick
@@ -126,14 +132,17 @@ See `erc-fools'.
The following values are allowed:
- nil - do not highlight the message at all
- `nick' - highlight fool's nickname only
- `all' - highlight the entire message from fool
+ nil - do not highlight the message at all
+ `nick' - highlight fool's nickname only
+ `message' - highlight the entire message from fool
+ `all' - highlight the entire message (including the nick)
+ from fool
Any other value disables fool highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
(defcustom erc-keyword-highlight-type 'keyword
@@ -143,12 +152,15 @@ See variable `erc-keywords'.
The following values are allowed:
`keyword' - highlight keyword only
- `all' - highlight the entire message containing keyword
+ `message' - highlight the entire message containing keyword
+ `all' - highlight the entire message (including the nick)
+ containing keyword
Any other value disables keyword highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const keyword)
+ (const message)
(const all)))
(defcustom erc-dangerous-host-highlight-type 'nick
@@ -157,13 +169,16 @@ See `erc-dangerous-hosts'.
The following values are allowed:
- `nick' - highlight nick from dangerous-host only
- `all' - highlight the entire message from dangerous-host
+ `nick' - highlight nick from dangerous-host only
+ `message' - highlight the entire message from dangerous-host
+ `all' - highlight the entire message (including the nick)
+ from dangerous-host
Any other value disables dangerous-host highlighting altogether."
:group 'erc-match
:type '(choice (const nil)
(const nick)
+ (const message)
(const all)))
@@ -449,19 +464,18 @@ Use this defun with `erc-insert-modify-hook'."
(match-beginning 0)))
(nick-end (when nick-beg
(match-end 0)))
- (message (buffer-substring
- (if (and nick-end
- (<= (+ 2 nick-end) (point-max)))
- ;; Message starts 2 characters after the nick
- ;; except for CTCP ACTION messages. Nick
- ;; surrounded by angle brackets only in normal
- ;; messages.
- (+ nick-end
- (if (eq ?> (char-after nick-end))
- 2
- 1))
- (point-min))
- (point-max))))
+ (message-beg (if (and nick-end
+ (<= (+ 2 nick-end) (point-max)))
+ ;; Message starts 2 characters after the
+ ;; nick except for CTCP ACTION messages.
+ ;; Nick surrounded by angle brackets only in
+ ;; normal messages.
+ (+ nick-end
+ (if (eq ?> (char-after nick-end))
+ 2
+ 1))
+ (point-min)))
+ (message (buffer-substring message-beg (point-max))))
(when (and vector
(not (and erc-match-exclude-server-buffer
(erc-server-buffer-p))))
@@ -498,7 +512,12 @@ Use this defun with `erc-insert-modify-hook'."
(while (re-search-forward match-regex nil t)
(erc-put-text-property (match-beginning 0) (match-end 0)
'font-lock-face match-face))))
- ;; Highlight the whole message
+ ;; Highlight the whole message (not including the nick)
+ ((eq match-htype 'message)
+ (erc-put-text-property
+ message-beg (point-max)
+ 'font-lock-face match-face (current-buffer)))
+ ;; Highlight the whole message (including the nick)
((eq match-htype 'all)
(erc-put-text-property
(point-min) (point-max)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index d0147b3..8799007 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -690,46 +690,47 @@ newline."
"Send the output from PROCESS (STRING) to the interactive display.
This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
- (current-buffer)))
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
- (let ((functions eshell-preoutput-filter-functions))
- (while (and functions string)
- (setq string (funcall (car functions) string))
- (setq functions (cdr functions))))
- (if (and string oprocbuf (buffer-name oprocbuf))
- (let (opoint obeg oend)
- (with-current-buffer oprocbuf
- (setq opoint (point))
- (setq obeg (point-min))
- (setq oend (point-max))
- (let ((buffer-read-only nil)
- (nchars (length string))
- (ostart nil))
- (widen)
- (goto-char eshell-last-output-end)
- (setq ostart (point))
- (if (<= (point) opoint)
- (setq opoint (+ opoint nchars)))
- (if (< (point) obeg)
- (setq obeg (+ obeg nchars)))
- (if (<= (point) oend)
- (setq oend (+ oend nchars)))
+ (current-buffer)))
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t))
+ (when (and string oprocbuf (buffer-name oprocbuf))
+ (with-current-buffer oprocbuf
+ (let ((functions eshell-preoutput-filter-functions))
+ (while (and functions string)
+ (setq string (funcall (car functions) string))
+ (setq functions (cdr functions))))
+ (when string
+ (let (opoint obeg oend)
+ (setq opoint (point))
+ (setq obeg (point-min))
+ (setq oend (point-max))
+ (let ((buffer-read-only nil)
+ (nchars (length string))
+ (ostart nil))
+ (widen)
+ (goto-char eshell-last-output-end)
+ (setq ostart (point))
+ (if (<= (point) opoint)
+ (setq opoint (+ opoint nchars)))
+ (if (< (point) obeg)
+ (setq obeg (+ obeg nchars)))
+ (if (<= (point) oend)
+ (setq oend (+ oend nchars)))
;; Let the ansi-color overlay hooks run.
(let ((inhibit-modification-hooks nil))
(insert-before-markers string))
- (if (= (window-start) (point))
- (set-window-start (selected-window)
- (- (point) nchars)))
- (if (= (point) eshell-last-input-end)
- (set-marker eshell-last-input-end
- (- eshell-last-input-end nchars)))
- (set-marker eshell-last-output-start ostart)
- (set-marker eshell-last-output-end (point))
- (force-mode-line-update))
- (narrow-to-region obeg oend)
- (goto-char opoint)
- (eshell-run-output-filters))))))
+ (if (= (window-start) (point))
+ (set-window-start (selected-window)
+ (- (point) nchars)))
+ (if (= (point) eshell-last-input-end)
+ (set-marker eshell-last-input-end
+ (- eshell-last-input-end nchars)))
+ (set-marker eshell-last-output-start ostart)
+ (set-marker eshell-last-output-end (point))
+ (force-mode-line-update))
+ (narrow-to-region obeg oend)
+ (goto-char opoint)
+ (eshell-run-output-filters)))))))
(defun eshell-run-output-filters ()
"Run the `eshell-output-filter-functions' on the current output."
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 4a50620..28f566d 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1109,6 +1109,121 @@ The arguments CHARS, BEG and END are handled as
described in
;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
"Last string returned by the function `ffap-string-at-point'.")
+(defcustom ffap-file-name-with-spaces nil
+ "If non-nil, enable looking for paths with spaces in `ffap-string-at-point'.
+Enabling this variable may lead to `find-file-at-point' guessing
+wrong more often when trying to find a file name intermingled
+with normal text, but can be useful when working on systems that
+normally use spaces in file names (like Microsoft Windows and the
+like)."
+ :type 'boolean
+ :version "28.1")
+
+(defun ffap-search-backward-file-end (&optional dir-separator end)
+ "Search backward position point where file would probably end.
+Optional DIR-SEPARATOR defaults to \"/\". The search maximum is
+`line-end-position' or optional END point.
+
+Suppose the cursor is somewhere that might be near end of file,
+the guessing would position point before punctuation (like comma)
+after the file extension:
+
+ C:\temp\file.log, which contain ....
+ =============================== (before)
+ ---------------- (after)
+
+
+ C:\temp\file.log on Windows or /tmp/file.log on Unix
+ =============================== (before)
+ ---------------- (after)
+
+The strategy is to search backward until DIR-SEPARATOR which defaults to
+\"/\" and then take educated guesses.
+
+Move point and return point if an adjustment was done."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let ((opoint (point))
+ point punct end whitespace-p)
+ (when (re-search-backward
+ (regexp-quote dir-separator) (line-beginning-position) t)
+ ;; Move to the beginning of the match..
+ (forward-char 1)
+ ;; ... until typical punctuation.
+ (when (re-search-forward "\\([][<>()\"'`,.:;]\\)"
+ (or end
+ (line-end-position))
+ t)
+ (setq end (match-end 0))
+ (setq punct (match-string 1))
+ (setq whitespace-p (looking-at "[ \t\r\n]\\|$"))
+ (goto-char end)
+ (cond
+ ((and (string-equal punct ".")
+ whitespace-p) ;end of sentence
+ (setq point (1- (point))))
+ ((and (string-equal punct ".")
+ (looking-at "[a-zA-Z0-9.]+")) ;possibly file extension
+ (setq point (match-end 0)))
+ (t
+ (setq point (point)))))
+ (goto-char opoint)
+ (when point
+ (goto-char point)
+ point))))
+
+(defun ffap-search-forward-file-end (&optional dir-separator)
+ "Search DIR-SEPARATOR and position point at file's maximum ending.
+This includes spaces.
+Optional DIR-SEPARATOR defaults to \"/\".
+Call `ffap-search-backward-file-end' to refine the ending point."
+ (unless dir-separator
+ (setq dir-separator "/"))
+ (let* ((chars ;expected chars in file name
+ (concat "[^][^<>()\"'`;,#*|"
+ ;; exclude the opposite as we know the separator
+ (if (string-equal dir-separator "/")
+ "\\\\"
+ "/")
+ "\t\r\n]"))
+ (re (concat
+ chars "*"
+ (if dir-separator
+ (regexp-quote dir-separator)
+ "/")
+ chars "*")))
+ (when (looking-at re)
+ (goto-char (match-end 0)))))
+
+(defun ffap-dir-separator-near-point ()
+ "Search backward and forward for closest slash or backlash in line.
+Return string slash or backslash. Point is moved to closest position."
+ (let ((point (point))
+ str pos)
+ (when (looking-at ".*?/")
+ (setq str "/"
+ pos (match-end 0)))
+ (when (and (looking-at ".*?\\\\")
+ (or (null pos)
+ (< (match-end 0) pos)))
+ (setq str "\\"
+ pos (match-end 0)))
+ (goto-char point)
+ (when (and (re-search-backward "/" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "/"
+ pos (1+ (point)))) ;1+ to keep cursor at the end of char
+ (goto-char point)
+ (when (and (re-search-backward "\\\\" (line-beginning-position) t)
+ (or (null pos)
+ (< (- point (point)) (- pos point))))
+ (setq str "\\"
+ pos (1+ (point))))
+ (when pos
+ (goto-char pos))
+ str))
+
(defun ffap-string-at-point (&optional mode)
"Return a string of characters from around point.
@@ -1128,7 +1243,8 @@ Set the variables `ffap-string-at-point' and
When the region is active and larger than `ffap-max-region-length',
return an empty string, and set `ffap-string-at-point-region' to '(1 1)."
- (let* ((args
+ (let* (dir-separator
+ (args
(cdr
(or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
(assq 'file ffap-string-at-point-mode-alist))))
@@ -1137,14 +1253,25 @@ return an empty string, and set
`ffap-string-at-point-region' to '(1 1)."
(beg (if region-selected
(region-beginning)
(save-excursion
- (skip-chars-backward (car args))
- (skip-chars-forward (nth 1 args) pt)
+ (if (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (when (setq dir-separator (ffap-dir-separator-near-point))
+ (while (re-search-backward
+ (regexp-quote dir-separator)
+ (line-beginning-position) t)
+ (goto-char (match-beginning 0))))
+ (skip-chars-backward (car args))
+ (skip-chars-forward (nth 1 args) pt))
(point))))
(end (if region-selected
(region-end)
(save-excursion
(skip-chars-forward (car args))
(skip-chars-backward (nth 2 args) pt)
+ (when (and ffap-file-name-with-spaces
+ (memq mode '(nil file)))
+ (ffap-search-forward-file-end dir-separator)
+ (ffap-search-backward-file-end dir-separator))
(point))))
(region-len (- (max beg end) (min beg end))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 4363860..c53f81f 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1913,7 +1913,8 @@ increase the score of each group you read."
"," gnus-summary-best-unread-article
"[" gnus-summary-prev-unseen-article
"]" gnus-summary-next-unseen-article
- "\M-s" gnus-summary-search-article-forward
+ "\M-s\M-s" gnus-summary-search-article-forward
+ "\M-s\M-r" gnus-summary-search-article-backward
"\M-r" gnus-summary-search-article-backward
"\M-S" gnus-summary-repeat-search-article-forward
"\M-R" gnus-summary-repeat-search-article-backward
diff --git a/lisp/ido.el b/lisp/ido.el
index e834916..ad7500c 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -2216,7 +2216,10 @@ If cursor is not at the end of the user input, move to
end of input."
((and ido-enable-virtual-buffers
ido-virtual-buffers
(setq filename (assoc buf ido-virtual-buffers)))
- (ido-visit-buffer (find-file-noselect (cdr filename)) method t))
+ (if (eq method 'kill)
+ (setq recentf-list
+ (delete (cdr filename) recentf-list))
+ (ido-visit-buffer (find-file-noselect (cdr filename)) method t)))
((and (eq ido-create-new-buffer 'prompt)
(null require-match)
@@ -4073,6 +4076,7 @@ Record command in `command-history' if optional RECORD is
non-nil."
(setq buffer (buffer-name buffer)))
(let (win newframe)
(cond
+ ;; "Killing" of virtual buffers is handled in `ido-buffer-internal'.
((eq method 'kill)
(if record
(ido-record-command 'kill-buffer buffer))
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index af3b493..f4b5503 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -131,31 +131,37 @@ lines."
(goto-char (match-end 0))
(unless (looking-at " ")
(insert " "))
- (end-of-line)
- (when (and (not (eobp))
- (save-excursion
- (forward-line 1)
- (looking-at (format "\\(%s ?\\)[^>]" prefix))))
- ;; Delete the newline and the quote at the start of the
- ;; next line.
- (delete-region (point) (match-end 1))
- (ignore-errors
+ (while (and (eq (char-before (line-end-position)) ?\s)
+ (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ (end-of-line)
+ (when (and (not (eobp))
+ (save-excursion
+ (forward-line 1)
+ (looking-at (format "\\(%s ?\\)[^>]" prefix))))
+ ;; Delete the newline and the quote at the start of the
+ ;; next line.
+ (delete-region (point) (match-end 1))))
+ (ignore-errors
(let ((fill-prefix (concat prefix " "))
adaptive-fill-mode)
(fill-region (line-beginning-position)
(line-end-position)
- 'left 'nosqueeze))))))
- (t
+ 'left 'nosqueeze)))))
+ (t
;; Delete the newline.
(when (eq (following-char) ?\s)
(delete-char 1))
;; Hack: Don't do the flowing on the signature line.
(when (and (not (looking-at "-- $"))
(eq (char-before (line-end-position)) ?\s))
- (end-of-line)
- (when delete-space
- (delete-char -1))
- (delete-char 1)
+ (while (eq (char-before (line-end-position)) ?\s)
+ (end-of-line)
+ (when delete-space
+ (delete-char -1))
+ (delete-char 1))
(ignore-errors
(let ((fill-prefix ""))
(fill-region (line-beginning-position)
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 317f2cd..8e2039b 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -162,23 +162,18 @@ Also see `mouse-wheel-tilt-scroll'."
:type 'boolean
:version "26.1")
-(eval-and-compile
- (if (fboundp 'event-button)
- (fset 'mwheel-event-button 'event-button)
- (defun mwheel-event-button (event)
- (let ((x (event-basic-type event)))
- ;; Map mouse-wheel events to appropriate buttons
- (if (eq 'mouse-wheel x)
- (let ((amount (car (cdr (cdr (cdr event))))))
- (if (< amount 0)
- mouse-wheel-up-event
- mouse-wheel-down-event))
- x))))
-
- (if (fboundp 'event-window)
- (fset 'mwheel-event-window 'event-window)
- (defun mwheel-event-window (event)
- (posn-window (event-start event)))))
+(defun mwheel-event-button (event)
+ (let ((x (event-basic-type event)))
+ ;; Map mouse-wheel events to appropriate buttons
+ (if (eq 'mouse-wheel x)
+ (let ((amount (car (cdr (cdr (cdr event))))))
+ (if (< amount 0)
+ mouse-wheel-up-event
+ mouse-wheel-down-event))
+ x)))
+
+(defun mwheel-event-window (event)
+ (posn-window (event-start event)))
(defvar mwheel-inhibit-click-event-timer nil
"Timer running while mouse wheel click event is inhibited.")
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 56ea033..bb66825 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -1,4 +1,4 @@
-;;; eudc-bob.el --- Binary Objects Support for EUDC
+;;; eudc-bob.el --- Binary Objects Support for EUDC -*- lexical-binding: t;
-*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -39,19 +39,41 @@
(require 'eudc)
-(defvar eudc-bob-generic-keymap nil
+(defvar eudc-bob-generic-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "s" 'eudc-bob-save-object)
+ (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
+ (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
+ map)
"Keymap for multimedia objects.")
-(defvar eudc-bob-image-keymap nil
+(defvar eudc-bob-image-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map eudc-bob-generic-keymap)
+ (define-key map "t" 'eudc-bob-toggle-inline-display)
+ map)
"Keymap for inline images.")
-(defvar eudc-bob-sound-keymap nil
+(defvar eudc-bob-sound-keymap
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map eudc-bob-generic-keymap)
+ (define-key map (kbd "RET") 'eudc-bob-play-sound-at-point)
+ (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
+ map)
"Keymap for inline sounds.")
-(defvar eudc-bob-url-keymap nil
+(defvar eudc-bob-url-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'browse-url-at-point)
+ (define-key map [down-mouse-2] 'browse-url-at-mouse)
+ map)
"Keymap for inline urls.")
-(defvar eudc-bob-mail-keymap nil
+(defvar eudc-bob-mail-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'goto-address-at-point)
+ (define-key map [down-mouse-2] 'goto-address-at-point)
+ map)
"Keymap for inline e-mail addresses.")
(defvar eudc-bob-generic-menu
@@ -74,13 +96,6 @@
(fboundp 'play-sound-internal)]
,@(cdr (cdr eudc-bob-generic-menu))))
-(defun eudc-jump-to-event (event)
- "Jump to the window and point where EVENT occurred."
- (if (fboundp 'event-closest-point)
- (goto-char (event-closest-point event))
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))))
-
(defun eudc-bob-get-overlay-prop (prop)
"Get property PROP from one of the overlays around."
(let ((overlays (append (overlays-at (1- (point)))
@@ -205,42 +220,30 @@ display a button."
"Play the sound data contained in the button where EVENT occurred."
(interactive "e")
(save-excursion
- (eudc-jump-to-event event)
+ (mouse-set-point event)
(eudc-bob-play-sound-at-point)))
-(defun eudc-bob-save-object ()
+(defun eudc-bob-save-object (filename)
"Save the object data of the button at point."
- (interactive)
+ (interactive "fWrite file: ")
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*")))
- (save-excursion
- (set-buffer-file-coding-system 'binary)
- (set-buffer buffer)
- (set-buffer-multibyte nil)
- (insert data)
- (save-buffer))
- (kill-buffer buffer)))
+ (coding-system-for-write 'binary)) ;Inhibit EOL conversion.
+ (write-region data nil filename)))
-(defun eudc-bob-pipe-object-to-external-program ()
+(defun eudc-bob-pipe-object-to-external-program (program)
"Pipe the object data of the button at point to an external program."
- (interactive)
+ (interactive (list (completing-read "Viewer: " eudc-external-viewers)))
(let ((data (eudc-bob-get-overlay-prop 'object-data))
- (buffer (generate-new-buffer "*eudc-tmp*"))
- program
- viewer)
- (condition-case nil
- (save-excursion
- (set-buffer-file-coding-system 'binary)
- (set-buffer buffer)
- (insert data)
- (setq program (completing-read "Viewer: " eudc-external-viewers))
- (if (setq viewer (assoc program eudc-external-viewers))
- (call-process-region (point-min) (point-max)
- (car (cdr viewer))
- (cdr (cdr viewer)))
- (call-process-region (point-min) (point-max) program)))
- (error
- (kill-buffer buffer)))))
+ (viewer (assoc program eudc-external-viewers)))
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert data)
+ (let ((coding-system-for-write 'binary)) ;Inhibit EOL conversion
+ (if viewer
+ (call-process-region (point-min) (point-max)
+ (car (cdr viewer))
+ (cdr (cdr viewer)))
+ (call-process-region (point-min) (point-max) program))))))
(defun eudc-bob-menu ()
"Retrieve the menu attached to a binary object."
@@ -250,47 +253,8 @@ display a button."
"Pop-up a menu of EUDC multimedia commands."
(interactive "@e")
(run-hooks 'activate-menubar-hook)
- (eudc-jump-to-event event)
- (let ((result (x-popup-menu t (eudc-bob-menu)))
- command)
- (if result
- (progn
- (setq command (lookup-key (eudc-bob-menu)
- (apply 'vector result)))
- (command-execute command)))))
-
-(setq eudc-bob-generic-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "s" 'eudc-bob-save-object)
- (define-key map "!" 'eudc-bob-pipe-object-to-external-program)
- (define-key map [down-mouse-3] 'eudc-bob-popup-menu)
- map))
-
-(setq eudc-bob-image-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map "t" 'eudc-bob-toggle-inline-display)
- map))
-
-(setq eudc-bob-sound-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'eudc-bob-play-sound-at-point)
- (define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
- map))
-
-(setq eudc-bob-url-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'browse-url-at-point)
- (define-key map [down-mouse-2] 'browse-url-at-mouse)
- map))
-
-(setq eudc-bob-mail-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'goto-address-at-point)
- (define-key map [down-mouse-2] 'goto-address-at-point)
- map))
-
-(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
-(set-keymap-parent eudc-bob-sound-keymap eudc-bob-generic-keymap)
+ (mouse-set-point event)
+ (popup-menu (eudc-bob-menu) event))
;; If the first arguments can be nil here, then these 3 can be
;; defconsts once more.
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index ebcd219..9401430 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -69,7 +69,6 @@
(require 'md4)
(require 'hmac-md5)
-(require 'calc)
(defgroup ntlm nil
"NTLM (NT LanManager) authentication."
@@ -133,32 +132,27 @@ is not given."
domain ;buffer field
))))
-(defun ntlm-compute-timestamp ()
- "Compute an NTLMv2 timestamp.
+(defun ntlm--time-to-timestamp (time)
+ "Convert TIME to an NTLMv2 timestamp.
Return a unibyte string representing the number of tenths of a
microsecond since January 1, 1601 as a 64-bit little-endian
-signed integer."
- ;; FIXME: This can likely be significantly simplified using the new
- ;; bignums support!
- (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
- (us-to-tenths-of-us "mul($3,10)")
- (ps-to-tenths-of-us "idiv($4,100000)")
- (tenths-of-us-since-jan-1-1601
- (apply #'calc-eval (concat "add(add(add("
- s-to-tenths-of-us ","
- us-to-tenths-of-us "),"
- ps-to-tenths-of-us "),"
- ;; tenths of microseconds between
- ;; 1601-01-01 and 1970-01-01
- "116444736000000000)")
- 'rawnum (time-convert nil 'list)))
- result-bytes)
- (dotimes (_byte 8)
- (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
- result-bytes)
- (setq tenths-of-us-since-jan-1-1601
- (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
- (apply #'unibyte-string (nreverse result-bytes))))
+signed integer. TIME must be on the form (HIGH LOW USEC PSEC)."
+ (let* ((s (+ (ash (nth 0 time) 16) (nth 1 time)))
+ (us (nth 2 time))
+ (ps (nth 3 time))
+ (tenths-of-us-since-jan-1-1601
+ (+ (* s 10000000) (* us 10) (/ ps 100000)
+ ;; tenths of microseconds between 1601-01-01 and 1970-01-01
+ 116444736000000000)))
+ (apply #'unibyte-string
+ (mapcar (lambda (i)
+ (logand (ash tenths-of-us-since-jan-1-1601 (* i -8))
+ #xff))
+ (number-sequence 0 7)))))
+
+(defun ntlm-compute-timestamp ()
+ "Current time as an NTLMv2 timestamp, as a unibyte string."
+ (ntlm--time-to-timestamp (time-convert nil 'list)))
(defun ntlm-generate-nonce ()
"Generate a random nonce, not to be used more than once.
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 3106c61..a043bbc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2417,12 +2417,9 @@ and runs `compilation-filter-hook'."
&optional object limit)
(let (parsed res)
(while (progn
- ;; We parse the buffer here "on-demand" by chunks of 500 chars.
- ;; But we could also just parse the whole buffer.
(compilation--ensure-parse
(setq parsed (max compilation--parsed
- (min (+ position 500)
- (or limit (point-max))))))
+ (or limit (point-max)))))
(and (or (not (setq res (next-single-property-change
position prop object limit)))
(eq res limit))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 2f44118..21ba42a 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1420,10 +1420,12 @@ Intended for `eldoc-documentation-functions' (which
see)."
(defun elisp-eldoc-var-docstring (callback &rest _ignored)
"Document variable at point.
Intended for `eldoc-documentation-functions' (which see)."
- (let ((sym (elisp--current-symbol)))
- (when sym (funcall callback (elisp-get-var-docstring sym)
- :thing sym
- :face 'font-lock-variable-name-face))))
+ (let* ((sym (elisp--current-symbol))
+ (docstring (and sym (elisp-get-var-docstring sym))))
+ (when docstring
+ (funcall callback docstring
+ :thing sym
+ :face 'font-lock-variable-name-face))))
(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index ff0b6a3..127b24c 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -214,7 +214,9 @@
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt perl--syntax-exp-intro-keywords)
- "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
+ "\\|[?:.,;|&*=!~({[]"
+ "\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
+ "\\|\\(^\\)\\)[ \t\n]*")))
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index b616135..8afd5ce 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,8 +1,8 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
-;; Version: 0.5.0
-;; Package-Requires: ((emacs "26.3"))
+;; Version: 0.5.1
+;; Package-Requires: ((emacs "26.3") (xref "1.0.2"))
;; This is a GNU ELPA :core package. Avoid using functionality that
;; not compatible with the version of Emacs recorded above.
@@ -731,24 +731,6 @@ pattern to search for."
(user-error "No matches for: %s" regexp))
xrefs))
-(defun project--process-file-region (start end program
- &optional buffer display
- &rest args)
- ;; FIXME: This branching shouldn't be necessary, but
- ;; call-process-region *is* measurably faster, even for a program
- ;; doing some actual work (for a period of time). Even though
- ;; call-process-region also creates a temp file internally
- ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
- (if (not (file-remote-p default-directory))
- (apply #'call-process-region
- start end program nil buffer display args)
- (let ((infile (make-temp-file "ppfr")))
- (unwind-protect
- (progn
- (write-region start end infile nil 'silent)
- (apply #'process-file program infile buffer display args))
- (delete-file infile)))))
-
(defun project--read-regexp ()
(let ((sym (thing-at-point 'symbol)))
(read-regexp "Find regexp" (and sym (regexp-quote sym)))))
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index f9b069f..0f2c943 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -115,6 +115,8 @@ treat nomenclature boundaries as word boundaries."
(when subword-mode (superword-mode -1))
(subword-setup-buffer))
+;; This is defined also in cc-cmds.el, but as obsolete since 24.3.
+;; Let's keep this until the other one can also be removed.
(define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2")
;;;###autoload
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 3e3a37f..bbf899e 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,8 +1,8 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
-;; Version: 1.0.1
-;; Package-Requires: ((emacs "26.3") (project "0.1.1"))
+;; Version: 1.0.2
+;; Package-Requires: ((emacs "26.3"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
;; compatible with the version of Emacs recorded above.
@@ -263,13 +263,16 @@ be found, return nil.
The default implementation uses `semantic-symref-tool-alist' to
find a search tool; by default, this uses \"find | grep\" in the
-`project-current' roots."
+current project's main and external roots."
(mapcan
(lambda (dir)
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
(cons
- (project-root pr)
+ (if (fboundp 'project-root)
+ (project-root pr)
+ (with-no-warnings
+ (project-roots pr)))
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
@@ -1281,13 +1284,13 @@ FILES must be a list of absolute file names."
(insert (mapconcat #'identity files "\0"))
(setq default-directory dir)
(setq status
- (project--process-file-region (point-min)
- (point-max)
- shell-file-name
- output
- nil
- shell-command-switch
- command)))
+ (xref--process-file-region (point-min)
+ (point-max)
+ shell-file-name
+ output
+ nil
+ shell-command-switch
+ command)))
(goto-char (point-min))
(when (and (/= (point-min) (point-max))
(not (looking-at grep-re))
@@ -1302,6 +1305,24 @@ FILES must be a list of absolute file names."
hits)))
(xref--convert-hits (nreverse hits) regexp)))
+(defun xref--process-file-region ( start end program
+ &optional buffer display
+ &rest args)
+ ;; FIXME: This branching shouldn't be necessary, but
+ ;; call-process-region *is* measurably faster, even for a program
+ ;; doing some actual work (for a period of time). Even though
+ ;; call-process-region also creates a temp file internally
+ ;; (http://lists.gnu.org/archive/html/emacs-devel/2019-01/msg00211.html).
+ (if (not (file-remote-p default-directory))
+ (apply #'call-process-region
+ start end program nil buffer display args)
+ (let ((infile (make-temp-file "ppfr")))
+ (unwind-protect
+ (progn
+ (write-region start end infile nil 'silent)
+ (apply #'process-file program infile buffer display args))
+ (delete-file infile)))))
+
(defun xref--rgrep-command (regexp files dir ignores)
(require 'find-dired) ; for `find-name-arg'
(defvar grep-find-template)
diff --git a/lisp/subr.el b/lisp/subr.el
index 8eb4cf4..0bd09c6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1649,7 +1649,8 @@ be a list of the form returned by `event-start' and
`event-end'."
(defalias 'point-at-eol 'line-end-position)
(defalias 'point-at-bol 'line-beginning-position)
-(defalias 'user-original-login-name 'user-login-name)
+(define-obsolete-function-alias 'user-original-login-name
+ 'user-login-name "28.1")
;;;; Hook manipulation functions.
diff --git a/lisp/term.el b/lisp/term.el
index 149405f..99f1bf4 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -467,6 +467,11 @@ Customize this option to nil if you want the previous
behavior."
:type 'boolean
:group 'term)
+(defcustom term-set-terminal-size nil
+ "If non-nil, set the LINES and COLUMNS environment variables."
+ :type 'boolean
+ :version "28.1")
+
(defcustom term-char-mode-point-at-process-mark t
"If non-nil, keep point at the process mark in char mode.
@@ -1551,9 +1556,12 @@ Nil if unknown.")
(format term-termcap-format "TERMCAP="
term-term-name term-height term-width)
- (format "INSIDE_EMACS=%s,term:%s" emacs-version
term-protocol-version)
- (format "LINES=%d" term-height)
- (format "COLUMNS=%d" term-width))
+ (format "INSIDE_EMACS=%s,term:%s"
+ emacs-version term-protocol-version))
+ (when term-set-terminal-size
+ (list
+ (format "LINES=%d" term-height)
+ (format "COLUMNS=%d" term-width)))
process-environment))
(process-connection-type t)
;; We should suppress conversion of end-of-line format.
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 39a1b48..8608f85 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -57,7 +57,6 @@
(defcustom flyspell-highlight-flag t
"How Flyspell should indicate misspelled words.
Non-nil means use highlight, nil means use minibuffer messages."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-mark-duplications-flag t
@@ -65,12 +64,10 @@ Non-nil means use highlight, nil means use minibuffer
messages."
See `flyspell-mark-duplications-exceptions' to add exceptions to this rule.
Detection of repeated words is not implemented in
\"large\" regions; see variable `flyspell-large-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-case-fold-duplications t
"Non-nil means Flyspell matches duplicate words case-insensitively."
- :group 'flyspell
:type 'boolean
:version "27.1")
@@ -87,7 +84,6 @@ dictionary name (`ispell-local-dictionary' or
EXCEPTION-LIST is a list of strings. The checked word is
downcased before comparing with these exceptions."
- :group 'flyspell
:type '(alist :key-type (choice (const :tag "All dictionaries" nil)
regexp)
:value-type (repeat string))
@@ -97,7 +93,6 @@ downcased before comparing with these exceptions."
"If non-nil, sort the corrections before popping them.
The sorting is controlled by the `flyspell-sort-corrections-function'
variable, and defaults to sorting alphabetically."
- :group 'flyspell
:version "21.1"
:type 'boolean)
@@ -109,8 +104,7 @@ function takes three parameters -- the two correction
candidates
to be sorted, and the third parameter is the word that's being
corrected."
:version "26.1"
- :type 'function
- :group 'flyspell)
+ :type 'function)
(defun flyspell-sort-corrections-alphabetically (corr1 corr2 _)
(string< corr1 corr2))
@@ -130,14 +124,12 @@ Flyspell uses a different face (`flyspell-duplicate') to
highlight it.
This variable specifies how far to search to find such a duplicate.
-1 means no limit (search the whole buffer).
0 means do not search for duplicate unrecognized spellings."
- :group 'flyspell
:version "24.5" ; -1 -> 400000
:type '(choice (const :tag "no limit" -1)
number))
(defcustom flyspell-delay 3
"The number of seconds to wait before checking, after a \"delayed\" command."
- :group 'flyspell
:type 'number)
(defcustom flyspell-persistent-highlight t
@@ -147,12 +139,10 @@ is highlighted, and the highlight is turned off as soon
as point moves
off the misspelled word.
Make sure this variable is non-nil if you use `flyspell-region'."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-highlight-properties t
"Non-nil means highlight incorrect words even if a property exists for this
word."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-default-delayed-commands
@@ -164,7 +154,6 @@ Make sure this variable is non-nil if you use
`flyspell-region'."
backward-delete-char-untabify)
"The standard list of delayed commands for Flyspell.
See `flyspell-delayed-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -172,7 +161,6 @@ See `flyspell-delayed-commands'."
"List of commands that are \"delayed\" for Flyspell mode.
After these commands, Flyspell checking is delayed for a short time,
whose length is specified by `flyspell-delay'."
- :group 'flyspell
:type '(repeat (symbol)))
(defcustom flyspell-default-deplacement-commands
@@ -182,7 +170,6 @@ whose length is specified by `flyspell-delay'."
scroll-down)
"The standard list of deplacement commands for Flyspell.
See variable `flyspell-deplacement-commands'."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
@@ -190,18 +177,15 @@ See variable `flyspell-deplacement-commands'."
"List of commands that are \"deplacement\" for Flyspell mode.
After these commands, Flyspell checking is performed only if the previous
command was not the very same command."
- :group 'flyspell
:version "21.1"
:type '(repeat (symbol)))
(defcustom flyspell-issue-welcome-flag t
"Non-nil means that Flyspell should display a welcome message when started."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-issue-message-flag t
"Non-nil means that Flyspell emits messages when checking words."
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-incorrect-hook nil
@@ -213,7 +197,6 @@ of possible corrections as returned by
`ispell-parse-output'.
If any of the functions return non-nil, the word is not highlighted as
incorrect."
- :group 'flyspell
:version "21.1"
:type 'hook)
@@ -225,14 +208,12 @@ when flyspell is started, the value of that variable is
used instead
of `flyspell-default-dictionary' to select the default dictionary.
Otherwise, if `flyspell-default-dictionary' is nil, it means to use
Ispell's ultimate default dictionary."
- :group 'flyspell
:version "21.1"
:type '(choice string (const :tag "Default" nil)))
(defcustom flyspell-tex-command-regexp
"\\(\\(begin\\|end\\)[
\t]*{\\|\\(cite[a-z*]*\\|label\\|ref\\|eqref\\|usepackage\\|documentclass\\)[
\t]*\\(\\[[^]]*\\]\\)?{[^{}]*\\)"
"A string that is the regular expression that matches TeX commands."
- :group 'flyspell
:version "21.1"
:type 'regexp)
@@ -241,34 +222,29 @@ Ispell's ultimate default dictionary."
TeX math environments are discovered by `texmathp', implemented
inside AUCTeX package. That package may be found at
URL `https://www.gnu.org/software/auctex/'"
- :group 'flyspell
:type 'boolean)
(defcustom flyspell-dictionaries-that-consider-dash-as-word-delimiter
'("francais" "deutsch8" "norsk")
"List of dictionary names that consider `-' as word delimiter."
- :group 'flyspell
:version "21.1"
:type '(repeat (string)))
(defcustom flyspell-abbrev-p
nil
"If non-nil, add correction to abbreviation table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-use-global-abbrev-table-p
nil
"If non-nil, prefer global abbrev table to local abbrev table."
- :group 'flyspell
:version "21.1"
:type 'boolean)
(defcustom flyspell-mode-line-string " Fly"
"String displayed on the mode line when flyspell is active.
Set this to nil if you don't want a mode line indicator."
- :group 'flyspell
:type '(choice string (const :tag "None" nil)))
(defcustom flyspell-large-region 1000
@@ -282,30 +258,25 @@ Doubled words are not detected in a large region, because
Ispell
does not check for them.
If this variable is nil, all regions are treated as small."
- :group 'flyspell
:version "21.1"
:type '(choice number (const :tag "All small" nil)))
(defcustom flyspell-insert-function (function insert)
"Function for inserting word by flyspell upon correction."
- :group 'flyspell
:type 'function)
(defcustom flyspell-before-incorrect-word-string nil
"String used to indicate an incorrect word starting."
- :group 'flyspell
:type '(choice string (const nil)))
(defcustom flyspell-after-incorrect-word-string nil
"String used to indicate an incorrect word ending."
- :group 'flyspell
:type '(choice string (const nil)))
(defvar flyspell-mode-map)
(defcustom flyspell-use-meta-tab t
"Non-nil means that flyspell uses M-TAB to correct word."
- :group 'flyspell
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (sym val)
@@ -316,8 +287,7 @@ If this variable is nil, all regions are treated as small."
(defcustom flyspell-auto-correct-binding
[(control ?\;)]
"The key binding for flyspell auto correction."
- :type 'key-sequence
- :group 'flyspell)
+ :type 'key-sequence)
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
@@ -475,6 +445,22 @@ like <img alt=\"Some thing.\">."
map)
"Minor mode keymap for Flyspell mode--for the whole buffer.")
+;; correct on mouse 3
+(defun flyspell--set-correct-on-mouse-3 (var value)
+ (set-default var value)
+ (if value
+ (progn (define-key flyspell-mouse-map [mouse-2] nil)
+ (define-key flyspell-mouse-map [mouse-3] 'flyspell-correct-word))
+ (define-key flyspell-mouse-map [mouse-2] 'flyspell-correct-word)
+ (define-key flyspell-mouse-map [mouse-3] nil)))
+
+(defcustom flyspell-correct-on-mouse-3 nil
+ "Non-nil means to bind `mouse-3' to `flyspell-correct-word'.
+If this is set, also unbind `mouse-2'."
+ :type 'boolean
+ :set 'flyspell--set-correct-on-mouse-3
+ :version "28.1")
+
;; dash character machinery
(defvar flyspell-consider-dash-as-word-delimiter-flag nil
"Non-nil means that the `-' char is considered as a word delimiter.")
@@ -493,8 +479,7 @@ like <img alt=\"Some thing.\">."
(t
:underline t :inherit error))
"Flyspell face for misspelled words."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defface flyspell-duplicate
'((((supports :underline (:style wave)))
@@ -503,8 +488,7 @@ like <img alt=\"Some thing.\">."
:underline t :inherit warning))
"Flyspell face for words that appear twice in a row.
See also `flyspell-duplicate-distance'."
- :version "24.4"
- :group 'flyspell)
+ :version "24.4")
(defvar flyspell-overlay nil)
@@ -546,7 +530,10 @@ in your init file.
:group 'flyspell
(if flyspell-mode
(condition-case err
- (flyspell-mode-on)
+ (progn
+ (when flyspell-correct-on-mouse-3
+ (flyspell--set-correct-on-mouse-3 'flyspell-correct-on-mouse-3
t))
+ (flyspell-mode-on))
(error (message "Error enabling Flyspell mode:\n%s" (cdr err))
(flyspell-mode -1)))
(flyspell-mode-off)))
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index f34ef81..be9b542 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -120,7 +120,7 @@ path components followed by `..' are removed, along with
the `..' itself."
;; Well, they told us the scheme, let's just go with it.
nil
(setf (url-type urlobj) (or (url-type urlobj) (url-type defobj)))
- (setf (url-port urlobj) (or (url-portspec urlobj)
+ (setf (url-portspec urlobj) (or (url-portspec urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
(url-port defobj))))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index d194d6c..bd5ac9b 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -2518,7 +2518,7 @@ fixed, visit it in a buffer."
'((?+ . (left-fringe diff-fringe-add
diff-indicator-added))
(?- . (left-fringe diff-fringe-del
diff-indicator-removed))
(?! . (left-fringe diff-fringe-rep
diff-indicator-changed))
- (?\s . (left-fringe diff-fringe-nul))))))
+ (?\s . (left-fringe diff-fringe-nul
fringe))))))
(put-text-property (match-beginning 0) (match-end 0) 'display
spec))))
;; Mimicks the output of Magit's diff.
;; FIXME: This has only been tested with Git's diff output.
diff --git a/src/ccl.c b/src/ccl.c
index ef059ff..e85cfa6 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -2219,15 +2219,8 @@ Return index number of the registered CCL program. */)
/* Extend the table. */
Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
- {
- Lisp_Object elt = make_uninit_vector (4);
-
- ASET (elt, 0, name);
- ASET (elt, 1, ccl_prog);
- ASET (elt, 2, resolved);
- ASET (elt, 3, Qt);
- ASET (Vccl_program_table, idx, elt);
- }
+ ASET (Vccl_program_table, idx,
+ CALLN (Fvector, name, ccl_prog, resolved, Qt));
Fput (name, Qccl_program_idx, make_fixnum (idx));
return make_fixnum (idx);
diff --git a/src/charset.c b/src/charset.c
index 8635aad..520dd3a 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1035,12 +1035,9 @@ usage: (define-charset-internal ...) */)
CHECK_FIXNAT (parent_max_code);
parent_code_offset = Fnth (make_fixnum (3), val);
CHECK_FIXNUM (parent_code_offset);
- val = make_uninit_vector (4);
- ASET (val, 0, make_fixnum (parent_charset->id));
- ASET (val, 1, parent_min_code);
- ASET (val, 2, parent_max_code);
- ASET (val, 3, parent_code_offset);
- ASET (attrs, charset_subset, val);
+ ASET (attrs, charset_subset,
+ CALLN (Fvector, make_fixnum (parent_charset->id),
+ parent_min_code, parent_max_code, parent_code_offset));
charset.method = CHARSET_METHOD_SUBSET;
/* Here, we just copy the parent's fast_map. It's not accurate,
diff --git a/src/coding.c b/src/coding.c
index 1d79c70..51bd441 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10856,20 +10856,17 @@ HIGHESTP non-nil means just return the highest
priority one. */)
return Fnreverse (val);
}
-static const char *const suffixes[] = { "-unix", "-dos", "-mac" };
-
static Lisp_Object
make_subsidiaries (Lisp_Object base)
{
- Lisp_Object subsidiaries;
+ static char const suffixes[][8] = { "-unix", "-dos", "-mac" };
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
USE_SAFE_ALLOCA;
char *buf = SAFE_ALLOCA (base_name_len + 6);
- int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
- subsidiaries = make_uninit_vector (3);
- for (i = 0; i < 3; i++)
+ Lisp_Object subsidiaries = make_nil_vector (3);
+ for (int i = 0; i < 3; i++)
{
strcpy (buf + base_name_len, suffixes[i]);
ASET (subsidiaries, i, intern (buf));
diff --git a/src/composite.c b/src/composite.c
index ec2b832..396d456 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1939,7 +1939,7 @@ syms_of_composite (void)
staticpro (&gstring_hash_table);
staticpro (&gstring_work_headers);
- gstring_work_headers = make_uninit_vector (8);
+ gstring_work_headers = make_nil_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, make_nil_vector (i + 2));
staticpro (&gstring_work);
diff --git a/src/fns.c b/src/fns.c
index 9199178..a3b8d6e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1747,25 +1747,27 @@ changing the value of a sequence `foo'. */)
{
if (VECTORP (seq))
{
- ptrdiff_t i, n;
+ ptrdiff_t n = 0;
+ ptrdiff_t size = ASIZE (seq);
+ USE_SAFE_ALLOCA;
+ Lisp_Object *kept = SAFE_ALLOCA (size * sizeof *kept);
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- ++n;
-
- if (n != ASIZE (seq))
+ for (ptrdiff_t i = 0; i < size; i++)
{
- struct Lisp_Vector *p = allocate_vector (n);
+ kept[n] = AREF (seq, i);
+ n += NILP (Fequal (AREF (seq, i), elt));
+ }
- for (i = n = 0; i < ASIZE (seq); ++i)
- if (NILP (Fequal (AREF (seq, i), elt)))
- p->contents[n++] = AREF (seq, i);
+ if (n != size)
+ seq = Fvector (n, kept);
- XSETVECTOR (seq, p);
- }
+ SAFE_FREE ();
}
else if (STRINGP (seq))
{
+ if (!CHARACTERP (elt))
+ return seq;
+
ptrdiff_t i, ibyte, nchars, nbytes, cbytes;
int c;
@@ -1784,7 +1786,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
++nchars;
nbytes += cbytes;
@@ -1814,7 +1816,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
- if (!FIXNUMP (elt) || c != XFIXNUM (elt))
+ if (c != XFIXNUM (elt))
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
diff --git a/src/font.c b/src/font.c
index ab00402..5c01c7f 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4847,21 +4847,18 @@ If the font is not OpenType font, CAPABILITY is nil.
*/)
(Lisp_Object font_object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- Lisp_Object val = make_uninit_vector (9);
-
- ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
- ASET (val, 2, make_fixnum (font->pixel_size));
- ASET (val, 3, make_fixnum (font->max_width));
- ASET (val, 4, make_fixnum (font->ascent));
- ASET (val, 5, make_fixnum (font->descent));
- ASET (val, 6, make_fixnum (font->space_width));
- ASET (val, 7, make_fixnum (font->average_width));
- if (font->driver->otf_capability)
- ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (val, 8, Qnil);
- return val;
+ return CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FILE_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
}
DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
@@ -4889,7 +4886,7 @@ the corresponding element is nil. */)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
ptrdiff_t len;
- Lisp_Object *chars, vec;
+ Lisp_Object *chars;
USE_SAFE_ALLOCA;
if (NILP (object))
@@ -4957,7 +4954,7 @@ the corresponding element is nil. */)
else
wrong_type_argument (Qarrayp, object);
- vec = make_uninit_vector (len);
+ Lisp_Object vec = make_nil_vector (len);
for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object g;
@@ -5168,24 +5165,23 @@ If the named font cannot be opened and loaded, return
nil. */)
return Qnil;
font = XFONT_OBJECT (font_object);
- info = make_uninit_vector (14);
- ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
- ASET (info, 2, make_fixnum (font->pixel_size));
- ASET (info, 3, make_fixnum (font->height));
- ASET (info, 4, make_fixnum (font->baseline_offset));
- ASET (info, 5, make_fixnum (font->relative_compose));
- ASET (info, 6, make_fixnum (font->default_ascent));
- ASET (info, 7, make_fixnum (font->max_width));
- ASET (info, 8, make_fixnum (font->ascent));
- ASET (info, 9, make_fixnum (font->descent));
- ASET (info, 10, make_fixnum (font->space_width));
- ASET (info, 11, make_fixnum (font->average_width));
- ASET (info, 12, AREF (font_object, FONT_FILE_INDEX));
- if (font->driver->otf_capability)
- ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (info, 13, Qnil);
+ info = CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FULLNAME_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->height),
+ make_fixnum (font->baseline_offset),
+ make_fixnum (font->relative_compose),
+ make_fixnum (font->default_ascent),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ AREF (font_object, FONT_FILE_INDEX),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
@@ -5203,7 +5199,7 @@ If the named font cannot be opened and loaded, return
nil. */)
static Lisp_Object
build_style_table (const struct table_entry *entry, int nelement)
{
- Lisp_Object table = make_uninit_vector (nelement);
+ Lisp_Object table = make_nil_vector (nelement);
for (int i = 0; i < nelement; i++)
{
int j;
@@ -5494,10 +5490,8 @@ This variable cannot be set; trying to do so will signal
an error. */);
make_symbol_constant (intern_c_string ("font-width-table"));
staticpro (&font_style_table);
- font_style_table = make_uninit_vector (3);
- ASET (font_style_table, 0, Vfont_weight_table);
- ASET (font_style_table, 1, Vfont_slant_table);
- ASET (font_style_table, 2, Vfont_width_table);
+ font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
+ Vfont_width_table);
DEFVAR_LISP ("font-log", Vfont_log, doc: /*
A list that logs font-related actions and results, for debugging.
diff --git a/src/fontset.c b/src/fontset.c
index c2bb8b2..8c86075 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object
fallback)
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
-/* Macros for FONT-DEF and RFONT-DEF of fontset. */
-#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
- do { \
- (font_def) = make_uninit_vector (3); \
- ASET ((font_def), 0, font_spec); \
- ASET ((font_def), 1, encoding); \
- ASET ((font_def), 2, repertory); \
- } while (0)
+/* Definitions for FONT-DEF and RFONT-DEF of fontset. */
+static Lisp_Object
+font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
+ Lisp_Object repertory)
+{
+ return CALLN (Fvector, font_spec, encoding, repertory);
+}
#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
@@ -1547,7 +1546,7 @@ appended. By default, FONT-SPEC overrides the previous
settings. */)
repertory = CHARSET_SYMBOL_ID (repertory);
}
}
- FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
+ font_def = font_def_new (font_spec, encoding, repertory);
}
else
font_def = Qnil;
@@ -1619,14 +1618,8 @@ appended. By default, FONT-SPEC overrides the previous
settings. */)
if (charset)
{
- Lisp_Object arg;
-
- arg = make_uninit_vector (5);
- ASET (arg, 0, fontset);
- ASET (arg, 1, font_def);
- ASET (arg, 2, add);
- ASET (arg, 3, ascii_changed ? Qt : Qnil);
- ASET (arg, 4, range_list);
+ Lisp_Object arg = CALLN (Fvector, fontset, font_def, add,
+ ascii_changed ? Qt : Qnil, range_list);
map_charset_chars (set_fontset_font, Qnil, arg, charset,
CHARSET_MIN_CODE (charset),
diff --git a/src/ftfont.c b/src/ftfont.c
index 696f5e6..a904007 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2826,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font
*font,
LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6);
LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6);
if (g->g.adjusted)
- {
- Lisp_Object vec = make_uninit_vector (3);
-
- ASET (vec, 0, make_fixnum (g->g.xoff >> 6));
- ASET (vec, 1, make_fixnum (g->g.yoff >> 6));
- ASET (vec, 2, make_fixnum (g->g.xadv >> 6));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (g->g.xoff >> 6),
+ make_fixnum (g->g.yoff >> 6),
+ make_fixnum (g->g.xadv >> 6)));
}
return make_fixnum (i);
}
diff --git a/src/hbfont.c b/src/hbfont.c
index 4b3f64e..82b115e 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction)
yoff = - lround (pos[i].y_offset * position_unit);
wadjust = lround (pos[i].x_advance * position_unit);
if (xoff || yoff || wadjust != metrics.width)
- {
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (xoff),
+ make_fixnum (yoff),
+ make_fixnum (wadjust)));
}
return make_fixnum (glyph_len);
diff --git a/src/lisp.h b/src/lisp.h
index 2962bab..7983339 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1809,7 +1809,8 @@ bool_vector_uchar_data (Lisp_Object a)
INLINE bool
bool_vector_bitref (Lisp_Object a, EMACS_INT i)
{
- eassume (0 <= i && i < bool_vector_size (a));
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
return !! (bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR]
& (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)));
}
@@ -1825,11 +1826,11 @@ bool_vector_ref (Lisp_Object a, EMACS_INT i)
INLINE void
bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
{
- unsigned char *addr;
-
- eassume (0 <= i && i < bool_vector_size (a));
- addr = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
+ eassume (0 <= i);
+ eassert (i < bool_vector_size (a));
+ unsigned char *addr
+ = &bool_vector_uchar_data (a)[i / BOOL_VECTOR_BITS_PER_CHAR];
if (b)
*addr |= 1 << (i % BOOL_VECTOR_BITS_PER_CHAR);
else
@@ -3915,7 +3916,6 @@ build_string (const char *str)
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
-extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
@@ -3925,7 +3925,11 @@ extern struct Lisp_Vector *allocate_nil_vector
(ptrdiff_t);
v = make_uninit_vector (3);
ASET (v, 0, obj0);
ASET (v, 1, Ffunction_can_gc ());
- ASET (v, 2, obj1); */
+ ASET (v, 2, obj1);
+
+ allocate_vector has a similar problem. */
+
+extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
diff --git a/src/macfont.m b/src/macfont.m
index c7430d3..9048146 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -3137,10 +3137,8 @@ macfont_shape (Lisp_Object lgstring, Lisp_Object
direction)
wadjust = lround (gl->advance);
if (xoff != 0 || yoff != 0 || wadjust != metrics.width)
{
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
+ Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff),
+ make_fixnum (yoff), make_fixnum (wadjust));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
}
diff --git a/src/nsselect.m b/src/nsselect.m
index 38ac66e..7b1937f 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -114,7 +114,7 @@ clean_local_selection_data (Lisp_Object obj)
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index 370abee..e81ca7f 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -388,7 +388,7 @@ js_to_lisp (id value)
NSArray *nsarr = (NSArray *) value;
EMACS_INT n = nsarr.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]);
@@ -401,7 +401,7 @@ js_to_lisp (id value)
NSArray *keys = nsdict.allKeys;
ptrdiff_t n = keys.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
diff --git a/src/pdumper.c b/src/pdumper.c
index bc41afc..2d1b192 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -4802,14 +4802,19 @@ struct dump_bitset
};
static bool
-dump_bitset_init (struct dump_bitset *bitset, size_t number_bits)
+dump_bitsets_init (struct dump_bitset bitset[2], size_t number_bits)
{
- int xword_size = sizeof (bitset->bits[0]);
+ int xword_size = sizeof (bitset[0].bits[0]);
int bits_per_word = xword_size * CHAR_BIT;
ptrdiff_t words_needed = divide_round_up (number_bits, bits_per_word);
- bitset->number_words = words_needed;
- bitset->bits = calloc (words_needed, xword_size);
- return bitset->bits != NULL;
+ dump_bitset_word *bits = calloc (words_needed, 2 * xword_size);
+ if (!bits)
+ return false;
+ bitset[0].bits = bits;
+ bitset[0].number_words = bitset[1].number_words = words_needed;
+ bitset[1].bits = memset (bits + words_needed, UCHAR_MAX,
+ words_needed * xword_size);
+ return true;
}
static dump_bitset_word *
@@ -4870,7 +4875,7 @@ struct pdumper_loaded_dump_private
/* Copy of the header we read from the dump. */
struct dump_header header;
/* Mark bits for objects in the dump; used during GC. */
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits, last_mark_bits;
/* Time taken to load the dump. */
double load_time;
/* Dump file name. */
@@ -4993,6 +4998,10 @@ pdumper_find_object_type_impl (const void *obj)
dump_off offset = ptrdiff_t_to_dump_off ((uintptr_t) obj -
dump_public.start);
if (offset % DUMP_ALIGNMENT != 0)
return PDUMPER_NO_OBJECT;
+ ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ if (offset < dump_private.header.cold_start
+ && !dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno))
+ return PDUMPER_NO_OBJECT;
const struct dump_reloc *reloc =
dump_find_relocation (&dump_private.header.object_starts, offset);
return (reloc != NULL && dump_reloc_get_offset (*reloc) == offset)
@@ -5021,12 +5030,16 @@ pdumper_set_marked_impl (const void *obj)
eassert (offset < dump_private.header.cold_start);
eassert (offset < dump_private.header.discardable_start);
ptrdiff_t bitno = offset / DUMP_ALIGNMENT;
+ eassert (dump_bitset_bit_set_p (&dump_private.last_mark_bits, bitno));
dump_bitset_set_bit (&dump_private.mark_bits, bitno);
}
void
pdumper_clear_marks_impl (void)
{
+ dump_bitset_word *swap = dump_private.last_mark_bits.bits;
+ dump_private.last_mark_bits.bits = dump_private.mark_bits.bits;
+ dump_private.mark_bits.bits = swap;
dump_bitset_clear (&dump_private.mark_bits);
}
@@ -5243,7 +5256,7 @@ pdumper_load (const char *dump_filename)
int dump_page_size;
dump_off adj_discardable_start;
- struct dump_bitset mark_bits;
+ struct dump_bitset mark_bits[2];
size_t mark_bits_needed;
struct dump_header header_buf = { 0 };
@@ -5357,7 +5370,7 @@ pdumper_load (const char *dump_filename)
err = PDUMPER_LOAD_ERROR;
mark_bits_needed =
divide_round_up (header->discardable_start, DUMP_ALIGNMENT);
- if (!dump_bitset_init (&mark_bits, mark_bits_needed))
+ if (!dump_bitsets_init (mark_bits, mark_bits_needed))
goto out;
/* Point of no return. */
@@ -5365,7 +5378,8 @@ pdumper_load (const char *dump_filename)
dump_base = (uintptr_t) sections[DS_HOT].mapping;
gflags.dumped_with_pdumper_ = true;
dump_private.header = *header;
- dump_private.mark_bits = mark_bits;
+ dump_private.mark_bits = mark_bits[0];
+ dump_private.last_mark_bits = mark_bits[1];
dump_public.start = dump_base;
dump_public.end = dump_public.start + dump_size;
diff --git a/src/search.c b/src/search.c
index 38c64ca..6fb3716 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3271,7 +3271,7 @@ the buffer. If the buffer doesn't have a cache, the
value is nil. */)
TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true);
/* Create vector and populate it. */
- cache_newlines = make_uninit_vector (nl_count_cache);
+ cache_newlines = make_vector (nl_count_cache, make_fixnum (-1));
if (nl_count_cache)
{
@@ -3285,15 +3285,12 @@ the buffer. If the buffer doesn't have a cache, the
value is nil. */)
break;
ASET (cache_newlines, i, make_fixnum (found - 1));
}
- /* Fill the rest of slots with an invalid position. */
- for ( ; i < nl_count_cache; i++)
- ASET (cache_newlines, i, make_fixnum (-1));
}
/* Now do the same, but without using the cache. */
find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE,
TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true);
- buf_newlines = make_uninit_vector (nl_count_buf);
+ buf_newlines = make_vector (nl_count_buf, make_fixnum (-1));
if (nl_count_buf)
{
for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++)
@@ -3306,14 +3303,10 @@ the buffer. If the buffer doesn't have a cache, the
value is nil. */)
break;
ASET (buf_newlines, i, make_fixnum (found - 1));
}
- for ( ; i < nl_count_buf; i++)
- ASET (buf_newlines, i, make_fixnum (-1));
}
/* Construct the value and return it. */
- val = make_uninit_vector (2);
- ASET (val, 0, cache_newlines);
- ASET (val, 1, buf_newlines);
+ val = CALLN (Fvector, cache_newlines, buf_newlines);
if (old != NULL)
set_buffer_internal_1 (old);
diff --git a/src/syntax.c b/src/syntax.c
index a03202d..9f77ea5 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -3617,9 +3617,9 @@ init_syntax_once (void)
DEFSYM (Qsyntax_table, "syntax-table");
/* Create objects which can be shared among syntax tables. */
- Vsyntax_code_object = make_uninit_vector (Smax);
+ Vsyntax_code_object = make_nil_vector (Smax);
for (i = 0; i < Smax; i++)
- ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil));
+ ASET (Vsyntax_code_object, i, list1 (make_fixnum (i)));
/* Now we are ready to set up this property, so we can
create syntax tables. */
diff --git a/src/window.c b/src/window.c
index e2dea8b..ef58f43 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7465,7 +7465,7 @@ saved by this function. */)
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window
: Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
data->focus_frame = FRAME_FOCUS_FRAME (f);
- Lisp_Object tem = make_uninit_vector (n_windows);
+ Lisp_Object tem = make_nil_vector (n_windows);
data->saved_windows = tem;
for (ptrdiff_t i = 0; i < n_windows; i++)
ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window)));
diff --git a/src/xdisp.c b/src/xdisp.c
index 4fe1c42..f05319a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -7555,7 +7555,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_space, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], ' ');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
@@ -7568,7 +7568,7 @@ get_next_display_element (struct it *it)
/* Merge `nobreak-space' into the current face. */
face_id = merge_faces (it->w, Qnobreak_hyphen, 0,
it->face_id);
- XSETINT (it->ctl_chars[0], '-');
+ XSETINT (it->ctl_chars[0], it->c);
ctl_len = 1;
goto display_control;
}
diff --git a/src/xfaces.c b/src/xfaces.c
index 2c6e593..06d2f99 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1572,22 +1572,18 @@ the face font sort order. */)
for (i = nfonts - 1; i >= 0; --i)
{
Lisp_Object font = AREF (vec, i);
- Lisp_Object v = make_uninit_vector (8);
- int point;
- Lisp_Object spacing;
-
- ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
- ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
- point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
- FRAME_RES_Y (f));
- ASET (v, 2, make_fixnum (point));
- ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
- ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
- spacing = Ffont_get (font, QCspacing);
- ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
- ASET (v, 6, Ffont_xlfd_name (font, Qnil));
- ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
-
+ int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
+ FRAME_RES_Y (f));
+ Lisp_Object spacing = Ffont_get (font, QCspacing);
+ Lisp_Object v = CALLN (Fvector,
+ AREF (font, FONT_FAMILY_INDEX),
+ FONT_WIDTH_SYMBOLIC (font),
+ make_fixnum (point),
+ FONT_WEIGHT_SYMBOLIC (font),
+ FONT_SLANT_SYMBOLIC (font),
+ NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt,
+ Ffont_xlfd_name (font, Qnil),
+ AREF (font, FONT_REGISTRY_INDEX));
result = Fcons (v, result);
}
diff --git a/src/xfns.c b/src/xfns.c
index 09dcbbf..07bba90 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6196,10 +6196,10 @@ Otherwise, the return value is a vector with the
following fields:
{
XFree (tmp_data);
- prop_attr = make_uninit_vector (3);
- ASET (prop_attr, 0, make_fixnum (actual_type));
- ASET (prop_attr, 1, make_fixnum (actual_format));
- ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >>
3)));
+ prop_attr = CALLN (Fvector,
+ make_fixnum (actual_type),
+ make_fixnum (actual_format),
+ make_fixnum (bytes_remaining / (actual_format >> 3)));
}
unblock_input ();
diff --git a/src/xselect.c b/src/xselect.c
index 48d6215..bf50c59 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info
*dpyinfo,
return x_atom_to_symbol (dpyinfo, (Atom) idata[0]);
else
{
- Lisp_Object v = make_uninit_vector (size / sizeof (int));
+ Lisp_Object v = make_nil_vector (size / sizeof (int));
for (i = 0; i < size / sizeof (int); i++)
ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i]));
@@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info
*dpyinfo,
else
{
ptrdiff_t i;
- Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
+ Lisp_Object v = make_nil_vector (size / X_LONG_SIZE);
if (type == XA_INTEGER)
{
@@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj)
Lisp_Object copy;
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/xwidget.c b/src/xwidget.c
index c61f5be..154b3e9 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -343,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value)
memory_full (SIZE_MAX);
ptrdiff_t n = dlen;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
@@ -361,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value)
Lisp_Object obj;
if (PTRDIFF_MAX < n)
memory_full (n);
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 30c8f79..e8c1266 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -77,6 +77,46 @@ left alone when opening a URL in an external browser."
(should (compare-window-configurations (current-window-configuration) old))
(should (equal urls '("https://www.gnu.org";)))))
+(defun ffap-test-string (space string)
+ (let ((ffap-file-name-with-spaces space))
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (forward-char 10)
+ (ffap-string-at-point))))
+
+(ert-deftest ffap-test-with-spaces ()
+ (should
+ (equal
+ (ffap-test-string
+ t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14
x86/Program here.txt")
+ "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program
here.txt"))
+ (should
+ (equal
+ (ffap-test-string
+ nil "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14
x86/Program here.txt")
+ "c:/Program"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:/Program Files/Open Text Evaluation Media/Open Text Exceed 14
x86/Program Files/Hummingbird/")
+ "/Program Files/Open Text Evaluation Media/Open Text Exceed 14 x86/Program
Files/Hummingbird/"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14
x86\\Program Files\\Hummingbird\\")
+ "\\Program Files\\Open Text Evaluation Media\\Open Text Exceed 14
x86\\Program Files\\Hummingbird\\"))
+ (should
+ (equal
+ (ffap-test-string
+ t "c:\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx
2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt")
+ "\\Program Files\\Freescale\\CW for MPC55xx and MPC56xx
2.10\\PowerPC_EABI_Tools\\Command_Line_Tools\\CLT_Usage_Notes.txt"))
+ (should
+ (equal
+ (ffap-test-string
+ t "C:\\temp\\program.log on Windows or /var/log/program.log on Unix.")
+ "\\temp\\program.log")))
+
(provide 'ffap-tests)
;;; ffap-tests.el ends here
diff --git a/test/lisp/mail/flow-fill-tests.el
b/test/lisp/mail/flow-fill-tests.el
index 4d435ae..c2e4178 100644
--- a/test/lisp/mail/flow-fill-tests.el
+++ b/test/lisp/mail/flow-fill-tests.el
@@ -35,7 +35,8 @@
">>> unmuzzled ratsbane!\n"
">>>> Henceforth, the coding style is to be strictly \n"
">>>> enforced, including the use of only upper case.\n"
- ">>>>> I've noticed a lack of adherence to the coding \n"
+ ">>>>> I've noticed a lack of adherence to \n"
+ ">>>>> the coding \n"
">>>>> styles, of late.\n"
">>>>>> Any complaints?\n"))
(output
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index f39f1ba..be8b42d 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -16,16 +16,17 @@
;;; Code:
-(defun cperl-test-face (text regexp)
- "Returns the face of the first character matched by REGEXP in TEXT."
+(defvar cperl-test-mode #'cperl-mode)
+
+(defun cperl-test-ppss (text regexp)
+ "Return the `syntax-ppss' of the first character matched by REGEXP in TEXT."
(interactive)
(with-temp-buffer
- (insert text)
- (cperl-mode)
- (font-lock-ensure (point-min) (point-max))
- (goto-char (point-min))
- (re-search-forward regexp)
- (get-text-property (match-beginning 0) 'face)))
+ (insert text)
+ (funcall cperl-test-mode)
+ (goto-char (point-min))
+ (re-search-forward regexp)
+ (syntax-ppss)))
(ert-deftest cperl-mode-test-bug-42168 ()
"Verify that '/' is a division after ++ or --, not a regexp.
@@ -37,14 +38,14 @@ have a face property."
;; The next two Perl expressions have divisions. Perl "punctuation"
;; operators don't get a face.
(let ((code "{ $a++ / $b }"))
- (should (equal (cperl-test-face code "/" ) nil)))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
(let ((code "{ $a-- / $b }"))
- (should (equal (cperl-test-face code "/" ) nil)))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) nil)))
;; The next two Perl expressions have regular expressions. The
;; delimiter of a RE is fontified with font-lock-constant-face.
(let ((code "{ $a+ / $b } # /"))
- (should (equal (cperl-test-face code "/" ) font-lock-constant-face)))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7)))
(let ((code "{ $a- / $b } # /"))
- (should (equal (cperl-test-face code "/" ) font-lock-constant-face))))
+ (should (equal (nth 8 (cperl-test-ppss code "/")) 7))))
;;; cperl-mode-tests.el ends here
diff --git a/test/lisp/url/url-expand-tests.el
b/test/lisp/url/url-expand-tests.el
index 6e0ce86..3b0b6fb 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -100,6 +100,13 @@
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar";)
"http://host/foo#bar";))
(should (equal (url-expand-file-name "foo#bar" "http://host/foobar/";)
"http://host/foobar/foo#bar";)))
+(ert-deftest url-expand-file-name/relative-resolution-file-url ()
+ "RFC 3986, Section 5.4 Reference Resolution Examples / Section 5.4.1. Normal
Examples"
+ (should (equal (url-expand-file-name "bar.html"
"file:///a/b/c/foo.html") "file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "bar.html" "file:///a/b/c/")
"file:///a/b/c/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html" "file:///a/b/c/")
"file:///a/b/d/bar.html"))
+ (should (equal (url-expand-file-name "../d/bar.html"
"file:///a/b/c/foo.html") "file:///a/b/d/bar.html")))
+
(provide 'url-expand-tests)
;;; url-expand-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f1faf58..400e912 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -895,3 +895,9 @@
;; This does not test randomness; it's merely a format check.
(should (string-match "\\`[0-9a-f]\\{128\\}\\'"
(secure-hash 'sha512 'iv-auto 100))))
+
+(ert-deftest test-vector-delete ()
+ (let ((v1 (make-vector 1000 1)))
+ (should (equal (delete t [nil t]) [nil]))
+ (should (equal (delete 1 v1) (vector)))
+ (should (equal (delete 2 v1) v1))))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master bdda935 2/2: Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs,
Lars Ingebrigtsen <=