[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 301cf0d 1/2: Merge remote-tracking branch 'savannah/
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp 301cf0d 1/2: Merge remote-tracking branch 'savannah/master' into HEAD |
|
Date: |
Thu, 23 Apr 2020 04:04:22 -0400 (EDT) |
branch: feature/native-comp
commit 301cf0d27892f76b7967d7f71d48a1899c27d477
Merge: 65cc8ef 7b15cc3
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Merge remote-tracking branch 'savannah/master' into HEAD
---
ChangeLog.3 | 16 +-
admin/notes/bug-triage | 2 +-
configure.ac | 25 +-
doc/emacs/cmdargs.texi | 2 +-
doc/emacs/dired.texi | 3 +-
doc/emacs/emacs.texi | 3 +-
doc/emacs/files.texi | 9 +-
doc/emacs/fixit.texi | 30 +-
doc/emacs/frames.texi | 5 +-
doc/emacs/misc.texi | 29 +-
doc/emacs/windows.texi | 20 +-
doc/lispintro/emacs-lisp-intro.texi | 32 +-
doc/lispref/abbrevs.texi | 6 +-
doc/lispref/backups.texi | 2 +-
doc/lispref/display.texi | 6 +-
doc/lispref/edebug.texi | 2 +-
doc/lispref/elisp.texi | 1 +
doc/lispref/eval.texi | 15 +-
doc/lispref/functions.texi | 4 +-
doc/lispref/help.texi | 56 ++-
doc/lispref/keymaps.texi | 33 +-
doc/lispref/lists.texi | 68 ++--
doc/lispref/objects.texi | 48 +++
doc/lispref/os.texi | 2 +-
doc/lispref/sequences.texi | 51 ++-
doc/lispref/strings.texi | 18 +-
doc/lispref/syntax.texi | 6 +-
doc/lispref/text.texi | 13 +-
doc/misc/cl.texi | 2 +-
doc/misc/efaq-w32.texi | 9 +-
doc/misc/gnus.texi | 7 +
doc/misc/tramp.texi | 17 +
etc/NEWS | 6 +
etc/NEWS.27 | 77 ++--
lib/ieee754.in.h | 4 +-
lisp/apropos.el | 71 ++--
lisp/autoarg.el | 7 +-
lisp/calculator.el | 2 +-
lisp/cdl.el | 2 +-
lisp/elide-head.el | 8 +-
lisp/emacs-lisp/bytecomp.el | 2 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
lisp/emacs-lisp/cl-macs.el | 8 +-
lisp/emacs-lisp/elp.el | 2 +-
lisp/emacs-lisp/generator.el | 32 +-
lisp/emacs-lisp/gv.el | 2 +-
lisp/emacs-lisp/lisp-mode.el | 2 +-
lisp/erc/erc.el | 17 +-
lisp/gnus/nntp.el | 4 +-
lisp/hi-lock.el | 5 +-
lisp/icomplete.el | 3 +-
lisp/image-mode.el | 76 ++--
lisp/image/exif.el | 4 +-
lisp/international/mule-util.el | 2 +-
lisp/json.el | 2 +-
lisp/ldefs-boot.el | 2 +-
lisp/minibuffer.el | 6 +-
lisp/net/tramp-gvfs.el | 4 +-
lisp/net/tramp-sh.el | 29 +-
lisp/net/tramp-smb.el | 41 +-
lisp/obsolete/cl.el | 2 +-
lisp/org/ob-screen.el | 2 +-
lisp/org/org-table.el | 2 +-
lisp/simple.el | 35 +-
lisp/sort.el | 3 +-
lisp/startup.el | 8 +-
lisp/strokes.el | 4 +-
lisp/subr.el | 6 +-
lisp/textmodes/ispell.el | 10 +-
nt/inc/ms-w32.h | 1 +
nt/mingw-cfg.site | 1 +
src/bidi.c | 20 +-
src/buffer.c | 11 +-
src/buffer.h | 140 +++++++
src/bytecode.c | 2 +-
src/casefiddle.c | 30 +-
src/ccl.c | 11 +-
src/character.c | 79 ++--
src/character.h | 786 +++++++++++++++---------------------
src/charset.c | 4 +-
src/chartab.c | 10 +-
src/cmds.c | 2 +-
src/coding.c | 75 ++--
src/composite.c | 42 +-
src/conf_post.h | 1 +
src/dispextern.h | 4 +-
src/editfns.c | 28 +-
src/eval.c | 2 +-
src/fns.c | 82 ++--
src/font.c | 38 +-
src/ftcrfont.c | 5 +-
src/image.c | 89 ++--
src/indent.c | 24 +-
src/insdel.c | 7 +-
src/keyboard.c | 10 +-
src/keymap.c | 171 ++++----
src/lisp.h | 2 +-
src/lread.c | 35 +-
src/marker.c | 10 +-
src/menu.c | 4 +-
src/msdos.c | 2 +-
src/nsfont.m | 2 +-
src/nsimage.m | 49 +++
src/nsmenu.m | 2 -
src/nsterm.h | 26 +-
src/nsterm.m | 535 +++++++++++++-----------
src/print.c | 31 +-
src/regex-emacs.c | 52 ++-
src/search.c | 46 +--
src/syntax.c | 135 +++----
src/sysdep.c | 14 +-
src/w32.c | 20 +
src/w32image.c | 210 ++++++----
src/xdisp.c | 90 ++---
src/xfont.c | 2 +-
src/xterm.c | 2 +-
test/lisp/apropos-tests.el | 133 ++++++
test/lisp/elide-head-tests.el | 62 +++
test/lisp/jsonrpc-tests.el | 4 +-
test/lisp/simple-tests.el | 4 +-
test/src/buffer-tests.el | 14 +
test/src/thread-tests.el | 2 +-
122 files changed, 2359 insertions(+), 1840 deletions(-)
diff --git a/ChangeLog.3 b/ChangeLog.3
index c5bc7b3..7f6000f 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -11660,7 +11660,7 @@
Mention the Emacs exit code in batch mode
* doc/lispref/os.texi (Batch Mode): Mention what the exit code is
- if an error is signalled (bug#31552).
+ if an error is signaled (bug#31552).
2019-10-12 Kaushal Modi <address@hidden>
@@ -15059,7 +15059,7 @@
* lisp/image/exif.el (exif-parse-buffer): New function.
(exif-orientation): Ditto.
- (exif-error): New error symbol, and adjust all error signalling to
+ (exif-error): New error symbol, and adjust all error signaling to
only use that signal.
2019-09-22 Andreas Schwab <address@hidden>
@@ -25100,7 +25100,7 @@
* lisp/json.el (json-read): Try to clarify what's returned (bug#34242).
(json-encode): Refer to `json-read' about what the input is and
- say what error is signalled.
+ say what error is signaled.
2019-07-09 Lars Ingebrigtsen <address@hidden>
@@ -26971,7 +26971,7 @@
help-C-file-name shouldn't error out if we can't find the name
* lisp/help-fns.el (help-C-file-name): Make help-C-file-name
- return nil instead of signalling an error if we can't find the
+ return nil instead of signaling an error if we can't find the
file name (bug#17250).
2019-06-26 Stefan Monnier <address@hidden>
@@ -34107,7 +34107,7 @@
Remove unused internal function completion-pcm--optimize-pattern
* lisp/minibuffer.el (completion-pcm--optimize-pattern): Remove
- unused internal function (that signalled a compilation warning).
+ unused internal function (that signaled a compilation warning).
2019-05-16 Stefan Monnier <address@hidden>
@@ -40134,10 +40134,10 @@
2019-03-30 Mattias Engdegård <address@hidden>
- Release regexp before signalling overflow error
+ Release regexp before signaling overflow error
* src/search.c (looking_at_1, search_buffer_re): Unfreeze the regexp
- buffer before signalling a matcher overflow, since the error
+ buffer before signaling a matcher overflow, since the error
processing may require quite some regexp use as well (Bug#34910).
2019-03-30 Mattias Engdegård <address@hidden>
@@ -88604,7 +88604,7 @@
Tweak Fdocumentation's error for an undefined function
* src/doc.c (Fdocumentation): Restore the pre-25 behavior
- of signalling a void-function error for an undefined function.
+ of signaling a void-function error for an undefined function.
This seems cleaner than Emacs 25's "invalid-function: nil" error,
which was (probably) an unintended consequence of changes to
Findirect_function.
diff --git a/admin/notes/bug-triage b/admin/notes/bug-triage
index 2974eee..87fb471 100644
--- a/admin/notes/bug-triage
+++ b/admin/notes/bug-triage
@@ -81,7 +81,7 @@ the ones that are not reproducible on the current release.
* New bug triage process
The goal of the new bug triage process is similar to the backlog triage
process,
-except that the focus is on prioritizing the bug, and making sure it is has
+except that the focus is on prioritizing the bug, and making sure it has
necessary information for others to act on.
For each new bug, ask the following questions:
diff --git a/configure.ac b/configure.ac
index e6ed723..c4d19e0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1911,6 +1911,8 @@ else
bitmapdir=${bmd_acc#:}
fi
+NATIVE_IMAGE_API=no
+
test "${with_ns}" = maybe && test "${opsys}" != darwin && with_ns=no
HAVE_NS=no
NS_GNUSTEP_CONFIG=no
@@ -2022,6 +2024,11 @@ Either fix this, or re-configure with the option
'--without-ns'.])])
AC_MSG_ERROR([Mac OS X 10.6 or newer is required]);
fi
fi
+
+ if test "${with_native_image_api}" = yes; then
+ AC_DEFINE(HAVE_NATIVE_IMAGE_API, 1, [Define to use native OS APIs for
images.])
+ NATIVE_IMAGE_API="yes (ns)"
+ fi
fi
AC_SUBST(LIBS_GNUSTEP)
@@ -2128,7 +2135,6 @@ LIB_WSOCK32=
NTLIB=
CM_OBJ="cm.o"
XARGS_LIMIT=
-NATIVE_IMAGE_API=no
if test "${HAVE_W32}" = "yes"; then
AC_DEFINE(HAVE_NTGUI, 1, [Define to use native MS Windows GUI.])
if test "$with_toolkit_scroll_bars" = "no"; then
@@ -3576,9 +3582,8 @@ AC_SUBST(LIBXPM)
### Use -ljpeg if available, unless '--with-jpeg=no'.
HAVE_JPEG=no
LIBJPEG=
-if test "${NS_IMPL_COCOA}" = yes; then
- : # Cocoa provides its own jpeg support, so do nothing.
-elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+if test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
if test "${with_jpeg}" != "no"; then
AC_CACHE_CHECK([for jpeglib 6b or later],
[emacs_cv_jpeglib],
@@ -3754,13 +3759,12 @@ AC_SUBST(COMP_OBJ)
HAVE_PNG=no
LIBPNG=
PNG_CFLAGS=
-if test "${NS_IMPL_COCOA}" = yes; then
- : # Cocoa provides its own png support, so do nothing.
-elif test "${with_png}" != no; then
+if test "${with_png}" != no; then
# mingw32 loads the library dynamically.
if test "$opsys" = mingw32; then
AC_CHECK_HEADER([png.h], [HAVE_PNG=yes])
- elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+ elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
EMACS_CHECK_MODULES([PNG], [libpng >= 1.0.0])
if test $HAVE_PNG = yes; then
LIBPNG=$PNG_LIBS
@@ -3834,7 +3838,8 @@ if test "${opsys}" = "mingw32"; then
if test "${HAVE_TIFF}" = "yes"; then
AC_DEFINE(HAVE_TIFF, 1, [Define to 1 if you have the tiff library
(-ltiff).])
fi
-elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes"; then
+elif test "${HAVE_X11}" = "yes" || test "${HAVE_W32}" = "yes" \
+ || test "${HAVE_NS}" = "yes"; then
if test "${with_tiff}" != "no"; then
AC_CHECK_HEADER(tiffio.h,
[tifflibs="-lz -lm"
@@ -3863,7 +3868,7 @@ if test "${opsys}" = "mingw32"; then
AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif (or ungif) library.])
fi
elif test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no" \
- || test "${HAVE_W32}" = "yes"; then
+ || test "${HAVE_W32}" = "yes" || test "${HAVE_NS}" = "yes"; then
AC_CHECK_HEADER(gif_lib.h,
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
# Earlier versions can crash Emacs, but version 5.0 removes
EGifPutExtensionLast.
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 9303b0b..2c13116 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -340,7 +340,7 @@ initialization file (@pxref{Resources}).
@opindex --quick
Start Emacs with minimum customizations. This is similar to using
@samp{-q}, @samp{--no-site-file}, @samp{--no-site-lisp},
-@samp{--no-x-resources}, and @samp{--no-splash} together..
+@samp{--no-x-resources}, and @samp{--no-splash} together.
@item -daemon
@opindex -daemon
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index fba4389..d514414 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -1416,7 +1416,8 @@ C-c}.
Image-Dired is a facility for browsing image files. It provides viewing
the images either as thumbnails or in full size, either inside Emacs
-or through an external viewer.
+or through an external viewer. This is different from Image mode
+(@pxref{Image Mode}) for visiting an image file in the Emacs buffer.
@kindex C-t d @r{(Image-Dired)}
@findex image-dired-display-thumbs
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 6ef4ca6..60f2be9 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -455,7 +455,8 @@ File Handling
* Remote Files:: Accessing files on other machines.
* Quoted File Names:: Quoting special characters in file names.
* File Name Cache:: Completion against a list of files you often use.
-* File Conveniences:: Convenience Features for Finding Files.
+* File Conveniences:: Convenience features for finding files.
+* Image Mode:: Viewing image files.
* Filesets:: Handling sets of files.
Saving Files
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index a89b16b..7d57555 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -38,7 +38,8 @@ on file directories.
* Remote Files:: Accessing files on other machines.
* Quoted File Names:: Quoting special characters in file names.
* File Name Cache:: Completion against a list of files you often use.
-* File Conveniences:: Convenience Features for Finding Files.
+* File Conveniences:: Convenience features for finding files.
+* Image Mode:: Viewing image files.
* Filesets:: Handling sets of files.
@end menu
@@ -2088,8 +2089,7 @@ of the cache with the @code{file-cache-display} command.
@section Convenience Features for Finding Files
In this section, we introduce some convenient facilities for finding
-recently-opened files, reading file names from a buffer, and viewing
-image files.
+recently-opened files, reading file names from a buffer.
@findex recentf-mode
@vindex recentf-mode
@@ -2108,6 +2108,9 @@ point. Partial Completion mode offers other features
extending
@code{find-file}, which can be used with @code{ffap}.
@xref{Completion Options}.
+@node Image Mode
+@section Viewing Image Files
+
@findex image-mode
@findex image-toggle-display
@findex image-next-file
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 2c268f1..5046146 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -204,8 +204,8 @@ sentences and paragraphs, respectively. These commands
work like
A numeric argument to a transpose command serves as a repeat count: it
tells the transpose command to move the character (or word or
expression or line) before or containing point across several other
-characters (or words or expressions or lines). For example, @kbd{C-u
-3 C-t} moves the character before point forward across three other
+characters (or words or expressions or lines). For example, @w{@kbd{C-u
+3 C-t}} moves the character before point forward across three other
characters. It would change @samp{f@point{}oobar} into
@samp{oobf@point{}ar}. This is equivalent to repeating @kbd{C-t}
three times. @kbd{C-u - 4 M-t} moves the word before point backward
@@ -307,10 +307,10 @@ region; @pxref{Disabled Transient Mark}.)
@cindex spell-checking the active region
Similarly, the command @kbd{M-x ispell} performs spell-checking in
the region if one is active, or in the entire buffer otherwise. The
-commands @kbd{M-x ispell-buffer} and @kbd{M-x ispell-region}
+commands @w{@kbd{M-x ispell-buffer}} and @w{@kbd{M-x ispell-region}}
explicitly perform spell-checking on the entire buffer or the region
respectively. To check spelling in an email message you are writing,
-use @kbd{M-x ispell-message}; that command checks the whole buffer,
+use @w{@kbd{M-x ispell-message}}; that command checks the whole buffer,
except for material that is indented or appears to be cited from other
messages. @xref{Sending Mail}.
@@ -368,8 +368,8 @@ wildcard.
@item C-g
@itemx X
Quit interactive spell-checking, leaving point at the word that was
-being checked. You can restart checking again afterward with @kbd{C-u
-M-$}.
+being checked. You can restart checking again afterward with @w{@kbd{C-u
+M-$}}.
@item x
Quit interactive spell-checking and move point back to where it was
@@ -387,8 +387,8 @@ Show the list of options.
(@code{ispell-complete-word}) performs in-buffer completion based on
spelling correction. Insert the beginning of a word, and then type
@kbd{M-@key{TAB}}; this shows a list of completions. (If your
-window manager intercepts @kbd{M-@key{TAB}}, type @kbd{@key{ESC}
-@key{TAB}} or @kbd{C-M-i}.) Each completion is listed with a digit or
+window manager intercepts @kbd{M-@key{TAB}}, type @w{@kbd{@key{ESC}
+@key{TAB}}} or @kbd{C-M-i}.) Each completion is listed with a digit or
character; type that digit or character to choose it.
@cindex @code{ispell} program
@@ -396,7 +396,7 @@ character; type that digit or character to choose it.
Once started, the spell-checker subprocess continues
to run, waiting for something to do, so that subsequent spell-checking
commands complete more quickly. If you want to get rid of the
-process, use @kbd{M-x ispell-kill-ispell}. This is not usually
+process, use @w{@kbd{M-x ispell-kill-ispell}}. This is not usually
necessary, since the process uses no processor time except when you do
spelling correction.
@@ -409,7 +409,7 @@ the standard dictionary and your personal dictionary. The
standard
dictionary is specified by the variable @code{ispell-local-dictionary}
or, if that is @code{nil}, by the variable @code{ispell-dictionary}.
If both are @code{nil}, the spelling program's default dictionary is
-used. The command @kbd{M-x ispell-change-dictionary} sets the
+used. The command @w{@kbd{M-x ispell-change-dictionary}} sets the
standard dictionary for the buffer and then restarts the subprocess,
so that it will use a different standard dictionary. Your personal
dictionary is specified by the variable
@@ -431,8 +431,8 @@ dictionary.
@findex flyspell-mode
Flyspell mode is a minor mode that performs automatic spell-checking
of the text you type as you type it. When it finds a word that it
-does not recognize, it highlights that word. Type @kbd{M-x
-flyspell-mode} to toggle Flyspell mode in the current buffer. To
+does not recognize, it highlights that word. Type @w{@kbd{M-x
+flyspell-mode}} to toggle Flyspell mode in the current buffer. To
enable Flyspell mode in all text mode buffers, add
@code{flyspell-mode} to @code{text-mode-hook}. @xref{Hooks}. Note
that, as Flyspell mode needs to check each word across which you move,
@@ -448,14 +448,14 @@ it with @kbd{mouse-2} (@code{flyspell-correct-word}) to
display a menu
of possible corrections and actions. 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
-@kbd{C-c $} (@code{flyspell-correct-word-before-point}) will pop up a
+@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
that it only checks words in comments and string constants. This
-feature is useful for editing programs. Type @kbd{M-x
-flyspell-prog-mode} to enable or disable this mode in the current
+feature is useful for editing programs. Type @w{@kbd{M-x
+flyspell-prog-mode}} to enable or disable this mode in the current
buffer. To enable this mode in all programming mode buffers, add
@code{flyspell-prog-mode} to @code{prog-mode-hook} (@pxref{Hooks}).
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 7a583b9..9421842 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -227,8 +227,9 @@ left. If you'd like to reverse the direction of horizontal
scrolling,
customize the variable @code{mouse-wheel-flip-direction} to a
non-@code{nil} value.
-When the mouse pointer is over an image, scrolling the mouse wheel
-with the @key{Ctrl} modifier scales the image under the mouse pointer.
+When the mouse pointer is over an image in Image mode, @pxref{Image Mode},
+scrolling the mouse wheel with the @key{Ctrl} modifier scales the image
+under the mouse pointer.
@node Word and Line Mouse
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index d097f4e..a15aa17 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -740,10 +740,11 @@ creates the file @file{foo} and produces no terminal
output.
A numeric argument to @code{shell-command}, e.g., @kbd{M-1 M-!},
causes it to insert terminal output into the current buffer instead of
-a separate buffer. It puts point before the output, and sets the mark
-after the output. For instance, @kbd{M-1 M-! gunzip < foo.gz
-@key{RET}} would insert the uncompressed form of the file
-@file{foo.gz} into the current buffer.
+a separate buffer. By default, it puts point before the output, and
+sets the mark after the output (but a non-default value of
+@code{shell-command-dont-erase-buffer} can change that, see below).
+For instance, @kbd{M-1 M-! gunzip < foo.gz @key{RET}} would insert the
+uncompressed form of the file @file{foo.gz} into the current buffer.
Provided the specified shell command does not end with @samp{&}, it
runs @dfn{synchronously}, and you must wait for it to exit before
@@ -829,11 +830,21 @@ inserted into a buffer of that name.
By default, the output buffer is erased between shell commands, except
when the output goes to the current buffer. If you change the value
of the option @code{shell-command-dont-erase-buffer} to @code{erase},
-then the output buffer is always erased. Any other non-@code{nil}
-value prevents to erase the output buffer.
+then the output buffer is always erased. Other non-@code{nil} values
+prevent erasing of the output buffer, and---if the output buffer is
+not the current buffer---also control where to put point after
+inserting the output of the shell command:
-This option also controls where to set the point in the output buffer
-after the command completes; see the documentation of the option for details.
+@table @code
+@item beg-last-out
+Puts point at the beginning of the last shell-command output.
+@item end-last-out
+Puts point at the end of the last shell-command output, i.e.@: at the
+end of the output buffer.
+@item save-point
+Restores the position of point as it was before inserting the
+shell-command output.
+@end table
@node Interactive Shell
@subsection Interactive Subshell
@@ -2872,7 +2883,7 @@ if there is an active region (@pxref{Mark}), the default
URL comes
from the region instead, after removing any whitespace from it. The
command then creates a new buffer with the embedded browser showing
the specified URL. The buffer is put in the Xwidget-WebKit mode
-(similar to Image mode, @pxref{File Conveniences}), which provides
+(similar to Image mode, @pxref{Image Mode}), which provides
one-key commands for scrolling the widget, changing its size, and
reloading it. Type @w{@kbd{C-h b}} in that buffer to see the key
bindings.
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index 2e07a98..910ef8f 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -586,13 +586,25 @@ buffer. @xref{Follow Mode}.
@cindex directional window selection
@findex windmove-right
@findex windmove-default-keybindings
+@findex windmove-display-default-keybindings
+@findex windmove-delete-default-keybindings
+@findex windmove-swap-states-in-direction
The Windmove package defines commands for moving directionally
between neighboring windows in a frame. @kbd{M-x windmove-right}
selects the window immediately to the right of the currently selected
-one, and similarly for the left, up, and down
-counterparts. @w{@kbd{M-x windmove-default-keybindings}} binds these
-commands to @kbd{S-right} etc.; doing so disables shift selection for
-those keys (@pxref{Shift Selection}).
+one, and similarly for the left, up, and down counterparts.
+@w{@kbd{M-x windmove-default-keybindings}} binds these commands to
+@kbd{S-right} etc.; doing so disables shift selection for those keys
+(@pxref{Shift Selection}). In the same way as keybindings can be
+defined for commands that select windows directionally, you can use
+@w{@kbd{M-x windmove-display-default-keybindings}} to define
+keybindings for commands that specify in what direction to display the
+window for the buffer that the next command is going to display.
+Also there is @w{@kbd{M-x windmove-delete-default-keybindings}} to
+define keybindings for commands that delete windows directionally, and
+@w{@kbd{M-x windmove-swap-states-in-direction}} that define
+keybindings for commands that swap the window contents of the selected
+window with the window in the specified direction.
The command @kbd{M-x compare-windows} lets you compare the text
shown in different windows. @xref{Comparing Files}.
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index 1726936..7484ce5 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -2329,7 +2329,7 @@ area.
@cindex @samp{bind} defined
There are several ways by which a variable can be given a value. One of
-the ways is to use either the function @code{set} or the function
+the ways is to use either the function @code{set} or the special form
@code{setq}. Another way is to use @code{let} (@pxref{let}). (The
jargon for this process is to @dfn{bind} a variable to a value.)
@@ -4517,7 +4517,7 @@ number; it will be printed as the character with that
@sc{ascii} code.
@item setq
@itemx set
-The @code{setq} function sets the value of its first argument to the
+The @code{setq} special form sets the value of its first argument to the
value of the second argument. The first argument is automatically
quoted by @code{setq}. It does the same for succeeding pairs of
arguments. Another function, @code{set}, takes only two arguments and
@@ -7317,11 +7317,21 @@ which leave the original list as it was. One way to
find out how this
works is to experiment. We will start with the @code{setcar} function.
@need 1200
+@cindex constant lists
+@cindex mutable lists
First, we can make a list and then set the value of a variable to the
-list, using the @code{setq} function. Here is a list of animals:
+list, using the @code{setq} special form. Because we intend to use
+@code{setcar} to change the list, this @code{setq} should not use the
+quoted form @code{'(antelope giraffe lion tiger)}, as that would yield
+a list that is part of the program and bad things could happen if we
+tried to change part of the program while running it. Generally
+speaking an Emacs Lisp program's components should be constant (or
+unchanged) while the program is running. So we instead construct an
+animal list that is @dfn{mutable} (or changeable) by using the
+@code{list} function, as follows:
@smallexample
-(setq animals '(antelope giraffe lion tiger))
+(setq animals (list 'antelope 'giraffe 'lion 'tiger))
@end smallexample
@noindent
@@ -7398,7 +7408,7 @@ To see how this works, set the value of the variable to a
list of
domesticated animals by evaluating the following expression:
@smallexample
-(setq domesticated-animals '(horse cow sheep goat))
+(setq domesticated-animals (list 'horse 'cow 'sheep 'goat))
@end smallexample
@need 1200
@@ -8846,7 +8856,7 @@ and then find the value of @code{trees}:
@smallexample
@group
-(setq trees '(maple oak pine birch))
+(setq trees (list 'maple 'oak 'pine 'birch))
@result{} (maple oak pine birch)
@end group
@@ -9366,7 +9376,7 @@ For example:
@smallexample
@group
-(setq triple '(1 2 3))
+(setq triple (list 1 2 3))
(setcar triple '37)
@@ -9547,7 +9557,7 @@ part of which is the address of the next pair. The very
last box
points to the symbol @code{nil}, which marks the end of the list.
@need 1200
-When a variable is set to a list with a function such as @code{setq},
+When a variable is set to a list with an operation such as @code{setq},
it stores the address of the first box in the variable. Thus,
evaluation of the expression
@@ -17092,7 +17102,7 @@ reminders.
@cindex Mail aliases
@noindent
-This @code{setq} command sets the value of the variable
+This @code{setq} sets the value of the variable
@code{mail-aliases} to @code{t}. Since @code{t} means true, the line
says, in effect, ``Yes, use mail aliases.''
@@ -17130,8 +17140,8 @@ The following turns off Indent Tabs mode:
@end smallexample
Note that this line uses @code{setq-default} rather than the
-@code{setq} command that we have seen before. The @code{setq-default}
-command sets values only in buffers that do not have their own local
+@code{setq} that we have seen before; @code{setq-default}
+sets values only in buffers that do not have their own local
values for the variable.
@ifinfo
diff --git a/doc/lispref/abbrevs.texi b/doc/lispref/abbrevs.texi
index 6689b56..575be18 100644
--- a/doc/lispref/abbrevs.texi
+++ b/doc/lispref/abbrevs.texi
@@ -370,9 +370,9 @@ definitions of @code{local-abbrev-table} and
@code{text-mode-abbrev-table}.
(funcall expand))))
(add-hook 'foo-mode-hook
- #'(lambda ()
- (add-function :around (local 'abbrev-expand-function)
- #'foo-mode-abbrev-expand-function)))
+ (lambda ()
+ (add-function :around (local 'abbrev-expand-function)
+ #'foo-mode-abbrev-expand-function)))
@end smallexample
@node Standard Abbrev Tables
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index b7318a9..4ed1a10 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -807,7 +807,7 @@ If you just want to automatically auto-revert every
@example
(setq-local buffer-stale-function
- #'(lambda (&optional noconfirm) 'fast))
+ (lambda (&optional noconfirm) 'fast))
@end example
@noindent
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 132a3c8..e01cfed 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -4358,7 +4358,7 @@ height.
@end defun
@defun destroy-fringe-bitmap bitmap
-This function destroy the fringe bitmap identified by @var{bitmap}.
+This function destroys the fringe bitmap identified by @var{bitmap}.
If @var{bitmap} identifies a standard fringe bitmap, it actually
restores the standard definition of that bitmap, instead of
eliminating it entirely.
@@ -6926,7 +6926,7 @@ end of the buffer continues from the other end. If
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
buttons can be found. If @var{no-error} in non-@code{nil}, return nil
-instead of signalling the error.
+instead of signaling the error.
@end deffn
@deffn Command backward-button n &optional wrap display-message
@@ -6938,7 +6938,7 @@ end of the buffer continues from the other end. If
is displayed. Any button with a non-@code{nil} @code{skip} property
is skipped over. Returns the button found, and signals an error if no
buttons can be found. If @var{no-error} in non-@code{nil}, return nil
-instead of signalling the error.
+instead of signaling the error.
@end deffn
@defun next-button pos &optional count-current
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index cfef5c1..5970e7c 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -858,7 +858,7 @@ to a non-@code{nil} value.
Here is an example of code that creates a circular structure:
@example
-(setq a '(x y))
+(setq a (list 'x 'y))
(setcar a a)
@end example
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index cfd96f7..bba1b63 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -297,6 +297,7 @@ Lisp Data Types
* Circular Objects:: Read syntax for circular structure.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
+* Constants and Mutability:: Whether an object's value can change.
Programming Types
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index f6f36ed..021604c 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -158,6 +158,12 @@ contents unchanged.
@end group
@end example
+ A self-evaluating form yields constant conses, vectors and strings, and you
+should not attempt to modify their contents via @code{setcar}, @code{aset} or
+similar operations. The Lisp interpreter might unify the constants
+yielded by your program's self-evaluating forms, so that these
+constants might share structure. @xref{Constants and Mutability}.
+
It is common to write numbers, characters, strings, and even vectors
in Lisp code, taking advantage of the fact that they self-evaluate.
However, it is quite unusual to do this for types that lack a read
@@ -558,6 +564,8 @@ and vectors.)
@defspec quote object
This special form returns @var{object}, without evaluating it.
+The returned value is a constant, and should not be modified.
+@xref{Constants and Mutability}.
@end defspec
@cindex @samp{'} for quoting
@@ -612,10 +620,12 @@ only part of a list, while computing and substituting
other parts.
@dfn{Backquote constructs} allow you to quote a list, but
selectively evaluate elements of that list. In the simplest case, it
-is identical to the special form @code{quote}
+is identical to the special form
@iftex
+@code{quote}.
@end iftex
@ifnottex
+@code{quote}
(described in the previous section; @pxref{Quoting}).
@end ifnottex
For example, these two forms yield identical results:
@@ -693,6 +703,9 @@ Here are some examples:
@end group
@end example
+If a subexpression of a backquote construct has no substitutions or
+splices, it acts like @code{quote} in that it yields constant conses,
+vectors and strings that should not be modified.
@node Eval
@section Eval
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 5cf67ba..bc8ec0e 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -970,7 +970,7 @@ string.
@end group
@group
-(mapconcat (function (lambda (x) (format "%c" (1+ x))))
+(mapconcat (lambda (x) (format "%c" (1+ x)))
"HAL-8000"
"")
@result{} "IBM.9111"
@@ -2287,7 +2287,7 @@ function) as a generalized variable. @var{setter} can be
a symbol in which
case it will be passed to @code{gv-define-simple-setter}, or it can be of the
form @code{(lambda (@var{arg}) @var{body})} in which case that function will
additionally have access to the macro (or function)'s arguments and it will
-passed to @code{gv-define-setter}.
+be passed to @code{gv-define-setter}.
@end table
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index eea1fd2..9b3c4fc 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -175,49 +175,47 @@ All symbols that have PATTERN in their name are described
in the *Help* buffer."
(interactive "sDescribe symbols matching: ")
(let ((describe-func
- (function
- (lambda (s)
+ (lambda (s)
@end group
@group
- ;; @r{Print description of symbol.}
- (if (fboundp s) ; @r{It is a function.}
- (princ
- (format "%s\t%s\n%s\n\n" s
- (if (commandp s)
- (let ((keys (where-is-internal s)))
- (if keys
- (concat
- "Keys: "
- (mapconcat 'key-description
- keys " "))
- "Keys: none"))
- "Function")
+ ;; @r{Print description of symbol.}
+ (if (fboundp s) ; @r{It is a function.}
+ (princ
+ (format "%s\t%s\n%s\n\n" s
+ (if (commandp s)
+ (let ((keys (where-is-internal s)))
+ (if keys
+ (concat
+ "Keys: "
+ (mapconcat 'key-description
+ keys " "))
+ "Keys: none"))
+ "Function")
@end group
@group
- (or (documentation s)
- "not documented"))))
+ (or (documentation s)
+ "not documented"))))
- (if (boundp s) ; @r{It is a variable.}
+ (if (boundp s) ; @r{It is a variable.}
@end group
@group
- (princ
- (format "%s\t%s\n%s\n\n" s
- (if (custom-variable-p s)
- "Option " "Variable")
+ (princ
+ (format "%s\t%s\n%s\n\n" s
+ (if (custom-variable-p s)
+ "Option " "Variable")
@end group
@group
- (or (documentation-property
- s 'variable-documentation)
- "not documented")))))))
+ (or (documentation-property
+ s 'variable-documentation)
+ "not documented"))))))
sym-list)
@end group
@group
;; @r{Build a list of symbols that match pattern.}
- (mapatoms (function
- (lambda (sym)
- (if (string-match pattern (symbol-name sym))
- (setq sym-list (cons sym sym-list))))))
+ (mapatoms (lambda (sym)
+ (if (string-match pattern (symbol-name sym))
+ (setq sym-list (cons sym sym-list)))))
@end group
@group
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 2c90d20..130ff0d 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1441,10 +1441,10 @@ Here is an example showing a keymap before and after
substitution:
@smallexample
@group
-(setq map '(keymap
- (?1 . olddef-1)
- (?2 . olddef-2)
- (?3 . olddef-1)))
+(setq map (list 'keymap
+ (cons ?1 olddef-1)
+ (cons ?2 olddef-2)
+ (cons ?3 olddef-1)))
@result{} (keymap (49 . olddef-1) (50 . olddef-2) (51 . olddef-1))
@end group
@@ -2226,14 +2226,11 @@ right value for selecting that button. Clicking on the
button should
set the variable so that the button you clicked on becomes selected.
@item :key-sequence @var{key-sequence}
-This property specifies which key sequence is likely to be bound to the
-same command invoked by this menu item. If you specify a correct key
-sequence, that sequence will be preferred over others.
-
-If you specify an incorrect key sequence, it has no effect; before Emacs
-displays @var{key-sequence} in the menu, it verifies that
-@var{key-sequence} is really equivalent to this menu item. Specifying
-@code{nil} for @var{key-sequence} is equivalent to the
+This property specifies which key sequence to display as keyboard equivalent.
+Before Emacs displays @var{key-sequence} in the menu, it verifies that
+@var{key-sequence} is really equivalent to this menu item, so it only
+has an effect if you specify a correct key sequence.
+Specifying @code{nil} for @var{key-sequence} is equivalent to the
@code{:key-sequence} attribute being absent.
@item :keys @var{string}
@@ -2916,17 +2913,17 @@ the following:
@table @code
@item :keys @var{keys}
-@var{keys} is a keyboard equivalent to the menu item (a string). This
-is normally not needed, as keyboard equivalents are computed
+@var{keys} is a string to display as keyboard equivalent to the menu item.
+This is normally not needed, as keyboard equivalents are computed
automatically. @var{keys} is expanded with
@code{substitute-command-keys} before it is displayed (@pxref{Keys in
Documentation}).
@item :key-sequence @var{keys}
-@var{keys} is a hint for speeding up Emacs's first display of the
-menu. It should be @code{nil} if you know that the menu item has no keyboard
-equivalent; otherwise it should be a string or vector specifying a
-keyboard equivalent for the menu item.
+@var{keys} is a hint indicating which key sequence to display as
+keyboard equivalent, in case the command is bound to several key sequences.
+It has no effect if @var{keys} is not bound to same command as this
+menu item.
@item :active @var{enable}
@var{enable} is an expression; if it evaluates to @code{nil}, the item
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 27fa538..1125af7 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -866,10 +866,15 @@ foo ;; @r{@code{foo} was changed.}
@node Modifying Lists
@section Modifying Existing List Structure
@cindex destructive list operations
+@cindex mutable lists
You can modify the @sc{car} and @sc{cdr} contents of a cons cell with the
primitives @code{setcar} and @code{setcdr}. These are destructive
operations because they change existing list structure.
+Destructive operations should be applied only to mutable lists,
+that is, lists constructed via @code{cons}, @code{list} or similar
+operations. Lists created by quoting are constants and should not be
+changed by destructive operations. @xref{Constants and Mutability}.
@cindex CL note---@code{rplaca} vs @code{setcar}
@quotation
@@ -906,7 +911,7 @@ value @var{object}. For example:
@example
@group
-(setq x '(1 2))
+(setq x (list 1 2)) ; @r{Create a mutable list.}
@result{} (1 2)
@end group
@group
@@ -926,8 +931,8 @@ these lists. Here is an example:
@example
@group
-;; @r{Create two lists that are partly shared.}
-(setq x1 '(a b c))
+;; @r{Create two mutable lists that are partly shared.}
+(setq x1 (list 'a 'b 'c))
@result{} (a b c)
(setq x2 (cons 'z (cdr x1)))
@result{} (z b c)
@@ -1017,11 +1022,11 @@ reached via the @sc{cdr}.
@example
@group
-(setq x '(1 2 3))
+(setq x (list 1 2 3)) ; @r{Create a mutable list.}
@result{} (1 2 3)
@end group
@group
-(setcdr x '(4))
+(setcdr x '(4)) ; @r{Modify the list's tail to be a constant list.}
@result{} (4)
@end group
@group
@@ -1037,7 +1042,7 @@ the @sc{cdr} of the first cons cell:
@example
@group
-(setq x1 '(a b c))
+(setq x1 (list 'a 'b 'c))
@result{} (a b c)
(setcdr x1 (cdr (cdr x1)))
@result{} (c)
@@ -1069,7 +1074,7 @@ of this list.
@example
@group
-(setq x1 '(a b c))
+(setq x1 (list 'a 'b 'c))
@result{} (a b c)
(setcdr x1 (cons 'd (cdr x1)))
@result{} (d b c)
@@ -1130,11 +1135,11 @@ Unlike @code{append} (@pxref{Building Lists}), the
@var{lists} are
@example
@group
-(setq x '(1 2 3))
+(setq x (list 1 2 3)) ; @r{Create a mutable list.}
@result{} (1 2 3)
@end group
@group
-(nconc x '(4 5))
+(nconc x '(4 5)) ; @r{Modify the list's tail to be a constant list.}
@result{} (1 2 3 4 5)
@end group
@group
@@ -1150,7 +1155,7 @@ list:
@example
@group
-(setq x '(1 2 3))
+(setq x (list 1 2 3))
@result{} (1 2 3)
@end group
@group
@@ -1163,11 +1168,13 @@ x
@end group
@end example
-However, the other arguments (all but the last) must be lists.
+However, the other arguments (all but the last) should be mutable lists.
-A common pitfall is to use a quoted constant list as a non-last
-argument to @code{nconc}. If you do this, your program will change
-each time you run it! Here is what happens:
+A common pitfall is to use a constant list as a non-last
+argument to @code{nconc}. If you do this, the resulting behavior
+is undefined. It is possible that your program will change
+each time you run it! Here is what might happen (though this
+is not guaranteed to happen):
@smallexample
@group
@@ -1270,7 +1277,7 @@ removing it involves changing the @sc{cdr}s
(@pxref{Setcdr}).
@example
@group
-(setq sample-list '(a b c (4)))
+(setq sample-list (list 'a 'b 'c '(4)))
@result{} (a b c (4))
@end group
@group
@@ -1303,12 +1310,12 @@ into the variable that held the original list:
(setq flowers (delq 'rose flowers))
@end example
-In the following example, the @code{(4)} that @code{delq} attempts to match
-and the @code{(4)} in the @code{sample-list} are not @code{eq}:
+In the following example, the @code{(list 4)} that @code{delq} attempts to
match
+and the @code{(4)} in the @code{sample-list} are @code{equal} but not
@code{eq}:
@example
@group
-(delq '(4) sample-list)
+(delq (list 4) sample-list)
@result{} (a c (4))
@end group
@end example
@@ -1324,7 +1331,7 @@ of @code{list}.
@example
@group
-(setq sample-list '(a b c a b c))
+(setq sample-list (list 'a 'b 'c 'a 'b 'c))
@result{} (a b c a b c)
@end group
@group
@@ -1349,12 +1356,12 @@ Compare this with @code{memq}:
@example
@group
-(memql 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} are @code{eql}.}
+(memql 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} must be @code{eql}.}
@result{} (1.2 1.3)
@end group
@group
-(memq 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} are not @code{eq}.}
- @result{} nil
+(memq 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} need not be
@code{eq}.}
+ @result{} nil ; @r{... or it might be @code{(1.2 1.3)}.}
@end group
@end example
@end defun
@@ -1373,11 +1380,11 @@ Compare this with @code{memq}:
@example
@group
-(member '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are @code{equal}.}
+(member (list 2) '((1) (2))) ; @r{@code{(list 2)} and @code{(2)} are
@code{equal}.}
@result{} ((2))
@end group
@group
-(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.}
+(memq (list 2) '((1) (2))) ; @r{@code{(list 2)} and @code{(2)} are not
@code{eq}.}
@result{} nil
@end group
@group
@@ -1407,7 +1414,7 @@ For example:
@example
@group
-(setq l '((2) (1) (2)))
+(setq l (list '(2) '(1) '(2)))
(delete '(2) l)
@result{} ((1))
l
@@ -1416,7 +1423,7 @@ l
;; @r{write @code{(setq l (delete '(2) l))}.}
@end group
@group
-(setq l '((2) (1) (2)))
+(setq l (list '(2) '(1) '(2)))
(delete '(1) l)
@result{} ((2) (2))
l
@@ -1618,9 +1625,10 @@ keys may not be symbols:
'(("simple leaves" . oak)
("compound leaves" . horsechestnut)))
-(assq "simple leaves" leaves)
+;; @r{The @code{copy-sequence} means the keys are not @code{eq}.}
+(assq (copy-sequence "simple leaves") leaves)
@result{} nil
-(assoc "simple leaves" leaves)
+(assoc (copy-sequence "simple leaves") leaves)
@result{} ("simple leaves" . oak)
@end smallexample
@end defun
@@ -1759,7 +1767,7 @@ correct results, use the return value of
@code{assq-delete-all} rather
than looking at the saved value of @var{alist}.
@example
-(setq alist '((foo 1) (bar 2) (foo 3) (lose 4)))
+(setq alist (list '(foo 1) '(bar 2) '(foo 3) '(lose 4)))
@result{} ((foo 1) (bar 2) (foo 3) (lose 4))
(assq-delete-all 'foo alist)
@result{} ((bar 2) (lose 4))
@@ -1926,7 +1934,7 @@ function returns the modified property list, so you can
store that back
in the place where you got @var{plist}. For example,
@example
-(setq my-plist '(bar t foo 4))
+(setq my-plist (list 'bar t 'foo 4))
@result{} (bar t foo 4)
(setq my-plist (plist-put my-plist 'foo 69))
@result{} (bar t foo 69)
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 855dff2..3e9f222 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -46,6 +46,10 @@ you store in it, type and all. (Actually, a small number of
Emacs
Lisp variables can only take on values of a certain type.
@xref{Variables with Restricted Values}.)
+ Some Lisp objects are @dfn{constant}: their values never change.
+Others are @dfn{mutable}: their values can be changed via destructive
+operations that involve side effects.
+
This chapter describes the purpose, printed representation, and read
syntax of each of the standard types in GNU Emacs Lisp. Details on how
to use these types can be found in later chapters.
@@ -59,6 +63,7 @@ to use these types can be found in later chapters.
* Circular Objects:: Read syntax for circular structure.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
+* Constants and Mutability:: Whether an object's value can change.
@end menu
@node Printed Representation
@@ -2377,3 +2382,46 @@ that for two strings to be equal, they have the same
text properties.
@end group
@end example
@end defun
+
+@node Constants and Mutability
+@section Constants and Mutability
+@cindex constants
+@cindex mutable objects
+
+ Some Lisp objects are constant: their values never change.
+For example, you can create a new integer by calculating one, but you
+cannot modify the value of an existing integer.
+
+ Other Lisp objects are mutable: their values can be changed
+via destructive operations involving side effects. For example, an
+existing marker can be changed by moving the marker to point to
+somewhere else.
+
+ Although numbers are always constants and markers are always
+mutable, some types contain both constant and mutable members. These
+types include conses, vectors, strings, and symbols. For example, the string
+literal @code{"aaa"} yields a constant string, whereas the function
+call @code{(make-string 3 ?a)} yields a mutable string that can be
+changed via later calls to @code{aset}.
+
+ Trying to modify a constant variable signals an error
+(@pxref{Constant Variables}).
+A program should not attempt to modify other types of constants because the
+resulting behavior is undefined: the Lisp interpreter might or might
+not detect the error, and if it does not detect the error the
+interpreter can behave unpredictably thereafter. Another way to put
+this is that although mutable objects are safe to change and constant
+symbols reliably reject attempts to change them, other constants are
+not safely mutable: if you try to change one your program might
+behave as you expect but it might crash or worse. This problem occurs
+with types that have both constant and mutable members, and that have
+mutators like @code{setcar} and @code{aset} that are valid on mutable
+objects but hazardous on constants.
+
+ When the same constant occurs multiple times in a program, the Lisp
+interpreter might save time or space by reusing existing constants or
+constant components. For example, @code{(eq "abc" "abc")} returns
+@code{t} if the interpreter creates only one instance of the string
+constant @code{"abc"}, and returns @code{nil} if it creates two
+instances. Lisp programs should be written so that they work
+regardless of whether this optimization is in use.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index e72858b..5c0b1e2 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2617,7 +2617,7 @@ if it is non-@code{nil}; this can be overridden by binding
This variable is non-@code{nil} when Emacs is running in batch mode.
@end defvar
-If Emacs exits due to signalling an error in batch mode, the exit
+If Emacs exits due to signaling an error in batch mode, the exit
status of the Emacs command is non-zero:
@example
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 1a3a04f..1cb0d05 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -183,11 +183,11 @@ for other ways to copy sequences.
@example
@group
-(setq bar '(1 2))
+(setq bar (list 1 2)) ; @r{Create a mutable list.}
@result{} (1 2)
@end group
@group
-(setq x (vector 'foo bar))
+(setq x (vector 'foo bar)) ; @r{Create a mutable vector.}
@result{} [foo (1 2)]
@end group
@group
@@ -278,7 +278,7 @@ Unlike @code{reverse} the original @var{sequence} may be
modified.
@example
@group
-(setq x '(a b c))
+(setq x (list 'a 'b 'c)) ; @r{Create a mutable list.}
@result{} (a b c)
@end group
@group
@@ -320,7 +320,7 @@ presented graphically:
For the vector, it is even simpler because you don't need setq:
@example
-(setq x [1 2 3 4])
+(setq x (copy-sequence [1 2 3 4])) ; @r{Create a mutable vector.}
@result{} [1 2 3 4]
(nreverse x)
@result{} [4 3 2 1]
@@ -330,7 +330,7 @@ x
Note that unlike @code{reverse}, this function doesn't work with strings.
Although you can alter string data by using @code{aset}, it is strongly
-encouraged to treat strings as immutable.
+encouraged to treat strings as immutable even when they are mutable.
@end defun
@@ -374,11 +374,11 @@ appears in a different position in the list due to the
change of
@example
@group
-(setq nums '(1 3 2 6 5 4 0))
+(setq nums (list 1 3 2 6 5 4 0)) ; @r{Create a mutable list.}
@result{} (1 3 2 6 5 4 0)
@end group
@group
-(sort nums '<)
+(sort nums #'<)
@result{} (0 1 2 3 4 5 6)
@end group
@group
@@ -396,7 +396,7 @@ of @code{sort} and use that. Most often we store the
result back into
the variable that held the original list:
@example
-(setq nums (sort nums '<))
+(setq nums (sort nums #'<))
@end example
For the better understanding of what stable sort is, consider the following
@@ -1228,7 +1228,7 @@ This function sets the @var{index}th element of
@var{array} to be
@example
@group
-(setq w [foo bar baz])
+(setq w (vector 'foo 'bar 'baz)) ; @r{Create a mutable vector.}
@result{} [foo bar baz]
(aset w 0 'fu)
@result{} fu
@@ -1237,7 +1237,8 @@ w
@end group
@group
-(setq x "asdfasfd")
+;; @r{@code{copy-sequence} creates a mutable string.}
+(setq x (copy-sequence "asdfasfd"))
@result{} "asdfasfd"
(aset x 3 ?Z)
@result{} 90
@@ -1246,6 +1247,10 @@ x
@end group
@end example
+The @var{array} should be mutable; that is, it should not be a constant,
+such as the constants created via quoting or via self-evaluating forms.
+@xref{Constants and Mutability}.
+
If @var{array} is a string and @var{object} is not a character, a
@code{wrong-type-argument} error results. The function converts a
unibyte string to multibyte if necessary to insert a character.
@@ -1257,7 +1262,8 @@ each element of @var{array} is @var{object}. It returns
@var{array}.
@example
@group
-(setq a [a b c d e f g])
+;; @r{Create a mutable vector and then fill it with zeros.}
+(setq a (copy-sequence [a b c d e f g]))
@result{} [a b c d e f g]
(fillarray a 0)
@result{} [0 0 0 0 0 0 0]
@@ -1265,7 +1271,8 @@ a
@result{} [0 0 0 0 0 0 0]
@end group
@group
-(setq s "When in the course")
+;; @r{Create a mutable string and then fill it with "-".}
+(setq s (copy-sequence "When in the course"))
@result{} "When in the course"
(fillarray s ?-)
@result{} "------------------"
@@ -1302,7 +1309,9 @@ same way in Lisp input.
A vector, like a string or a number, is considered a constant for
evaluation: the result of evaluating it is the same vector. This does
not evaluate or even examine the elements of the vector.
-@xref{Self-Evaluating Forms}.
+@xref{Self-Evaluating Forms}. Vectors written with square brackets
+are constants and should not be modified via @code{aset} or other
+destructive operations. @xref{Constants and Mutability}.
Here are examples illustrating these principles:
@@ -1565,14 +1574,14 @@ For example, here is how to examine the elements of the
syntax table:
@example
(let (accumulator)
(map-char-table
- #'(lambda (key value)
- (setq accumulator
- (cons (list
- (if (consp key)
- (list (car key) (cdr key))
- key)
- value)
- accumulator)))
+ (lambda (key value)
+ (setq accumulator
+ (cons (list
+ (if (consp key)
+ (list (car key) (cdr key))
+ key)
+ value)
+ accumulator)))
(syntax-table))
accumulator)
@result{}
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 14cabc5..a4c9c25 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -51,10 +51,8 @@ by a distinguished character code.
operate on them with the general array and sequence functions documented
in @ref{Sequences Arrays Vectors}. For example, you can access or
change individual characters in a string using the functions @code{aref}
-and @code{aset} (@pxref{Array Functions}). However, note that
-@code{length} should @emph{not} be used for computing the width of a
-string on display; use @code{string-width} (@pxref{Size of Displayed
-Text}) instead.
+and @code{aset} (@pxref{Array Functions}). However, you should not
+try to change the contents of constant strings (@pxref{Modifying Strings}).
There are two text representations for non-@acronym{ASCII}
characters in Emacs strings (and in buffers): unibyte and multibyte.
@@ -89,6 +87,9 @@ copy them into buffers. @xref{Character Type}, and
@ref{String Type},
for information about the syntax of characters and strings.
@xref{Non-ASCII Characters}, for functions to convert between text
representations and to encode and decode character codes.
+Also, note that @code{length} should @emph{not} be used for computing
+the width of a string on display; use @code{string-width} (@pxref{Size
+of Displayed Text}) instead.
@node Predicates for Strings
@section Predicates for Strings
@@ -380,6 +381,11 @@ usual value is @w{@code{"[ \f\t\n\r\v]+"}}.
@cindex modifying strings
@cindex string modification
+ You can alter the contents of a mutable string via operations
+described in this section. However, you should not try to use these
+operations to alter the contents of a constant string.
+@xref{Constants and Mutability}.
+
The most basic way to alter the contents of an existing string is with
@code{aset} (@pxref{Array Functions}). @code{(aset @var{string}
@var{idx} @var{char})} stores @var{char} into @var{string} at index
@@ -591,7 +597,7 @@ for sorting (@pxref{Sequence Functions}):
@example
@group
-(sort '("11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
+(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2") 'string-collate-lessp)
@result{} ("11" "1 1" "1.1" "12" "1 2" "1.2")
@end group
@end example
@@ -608,7 +614,7 @@ systems. The @var{locale} value of @code{"POSIX"} or
@code{"C"} lets
@example
@group
-(sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+(sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (s1 s2) (string-collate-lessp s1 s2 "POSIX")))
@result{} ("1 1" "1 2" "1.1" "1.2" "11" "12")
@end group
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index ad45a8e..9eb99a0 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -1118,9 +1118,9 @@ bidi-class}).
;; 'bidi-class' Unicode property is R, AL, or RLO --
;; these have a right-to-left directionality.
(map-char-table
- #'(lambda (key val)
- (if (memq val '(R AL RLO))
- (modify-category-entry key ?R category-table)))
+ (lambda (key val)
+ (if (memq val '(R AL RLO))
+ (modify-category-entry key ?R category-table)))
uniprop-table)
category-table))
@end example
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index ffdf952..58424a4 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -2073,11 +2073,10 @@ its @code{sort-subr} call looks like this:
@example
@group
(sort-subr reverse
- (function
- (lambda ()
- (while (and (not (eobp))
- (looking-at paragraph-separate))
- (forward-line 1))))
+ (lambda ()
+ (while (and (not (eobp))
+ (looking-at paragraph-separate))
+ (forward-line 1)))
'forward-paragraph)
@end group
@end example
@@ -4679,7 +4678,7 @@ expanded when the header line is computed. To do this,
the
above. @var{specification} is an alist that has elements where the
@code{car} is a character and the @code{cdr} is the substitution.
-If @code{ONLY-PRESENT} is @code{nil}, errors will be signalled if a
+If @code{ONLY-PRESENT} is @code{nil}, errors will be signaled if a
format character has been used that's not present in
@var{specification}. If it's non-@code{nil}, that format
specification is left verbatim in the result.
@@ -5725,7 +5724,7 @@ made within the @code{combine-after-change-calls} body.
@code{after-change-functions} within
the body of a @code{combine-after-change-calls} form.
-@strong{Warning:} if the changes you combine occur in widely scattered
+@strong{Warning:} If the changes you combine occur in widely scattered
parts of the buffer, this will still work, but it is not advisable,
because it may lead to inefficient behavior for some change hook
functions.
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a2cfe61..b5f26e0 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3128,7 +3128,7 @@ floating-point number, namely the IEEE binary64
floating-point format.
@defvar cl-most-positive-float
This constant equals the largest finite value a Lisp float can hold.
-For IEEE binary64 format, this equals @code{(- (expt 2 1024) (- 2
+For IEEE binary64 format, this equals @code{(- (expt 2 1024) (expt 2
971))}, which equals @code{1.7976931348623157e+308}.
@end defvar
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index 02e63c7..83dd176 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -942,10 +942,13 @@ To find the XFLD name for a font, you can execute the
following in the
(x-select-font nil t)
@end example
-To see a complete list of fonts, execute the following in the
-@file{*scratch*} buffer by pressing C-x C-e at the end of the line:
+To see a complete list of fonts, execute the following Lisp snippet by
+typing it into the @file{*scratch*} buffer and pressing @w{@kbd{C-x
+C-e}} at the end of the second line:
+
@example
-(insert (prin1-to-string (x-list-fonts "*")))
+(dolist (font (x-list-fonts "*"))
+ (insert (format "%s\n" font)))
@end example
The command line options and frame-parameters for changing the default font
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 424e15b..718e269 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -25668,6 +25668,13 @@ Create non-spam statistics for every file in this
directory. Every
file is treated as one non-spam mail.
@end defun
+@defvar spam-stat-process-directory-age
+Maximum age of files to be processed, in days. Without this filter,
+re-training spam-stat with several thousand messages could take a long
+time. The default is 90, but you might want to set this to a bigger
+value during the initial training.
+@end defvar
+
Usually you would call @code{spam-stat-process-spam-directory} on a
directory such as @file{~/Mail/mail/spam} (this usually corresponds to
the group @samp{nnml:mail.spam}), and you would call
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 4e39728..0b13c17 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -4144,6 +4144,23 @@ your proxy host.
@item
+@value{tramp} does not connect to Samba or MS Windows hosts running
+SMB1 connection protocol.
+
+@vindex tramp-smb-options
+Recent versions of @command{smbclient} do not support old connection
+protocols by default. In order to connect to such a host, add a
+respective option:
+
+@lisp
+(add-to-list 'tramp-smb-options "client min protocol=NT1")
+@end lisp
+
+@strong{Note} that using a deprecated connection protocol raises
+security problems, you should do it only if absolutely necessary.
+
+
+@item
File name completion does not work with @value{tramp}
@acronym{ANSI} escape sequences from the remote shell may cause errors
diff --git a/etc/NEWS b/etc/NEWS
index 396c757..025d5c1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -282,6 +282,12 @@ This is used when invoking 'texi2dvi' from
'texinfo-tex-buffer'.
Its default value matches localized abbreviations of the "reply"
prefix on the Subject line in various languages.
+** Apropos
+
+*** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'.
+These new navigation commands are bound to 'n' and 'p' in
+'apropos-mode'.
+
* New Modes and Packages in Emacs 28.1
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index aba3028..091c831 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -934,7 +934,7 @@ back, customize 'follow-hide-ghost-cursors' to nil.
*** 'windmove-create-window' when non-nil makes a new window.
This happens upon moving off the edge of the frame.
----
++++
*** Windmove supports directional window display and selection.
The new command 'windmove-display-default-keybindings' binds default
keys with provided modifiers (by default, Shift-Meta) to the commands
@@ -948,7 +948,7 @@ display the buffer in the same window, for example, 'S-M-0
C-h e'
displays the "*Messages*" buffer in the same window. 'S-M-t C-h C-n'
displays NEWS in a new tab.
----
++++
*** Windmove also supports directional window deletion.
The new command 'windmove-delete-default-keybindings' binds default
keys with provided prefix (by default, 'C-x') and modifiers (by default,
@@ -958,7 +958,7 @@ With a prefix arg 'C-u', also kills the buffer in that
window.
With 'M-0', deletes the selected window and selects the window
that was in the specified direction.
----
++++
*** New command 'windmove-swap-states-in-direction' binds default keys
to the commands that swap the states of the selected window with the
window in the specified direction.
@@ -1011,10 +1011,6 @@ remapped to these, respectively.
** Dired
----
-*** On systems that support suid/guid files, Dired now fontifies the
-permissions of such files with a special face 'dired-set-id'.
-
+++
*** New command 'dired-create-empty-file'.
@@ -1026,10 +1022,6 @@ It is by default bound to '* N'.
*** The marking commands now report how many files were marked by the
command itself, not how many files are marked in total.
----
-*** A new face, 'dired-special', is used to highlight sockets, named
-pipes, block devices and character devices.
-
+++
*** The new user option 'dired-create-destination-dirs' controls whether
'dired-do-copy' and 'dired-rename-file' should create non-existent
@@ -1047,6 +1039,14 @@ Dired performs file renaming using underlying version
control system.
*** Zstandard compression is now supported for 'dired-do-compress' and
'dired-do-compress-to'.
+---
+*** On systems that support suid/guid files, Dired now fontifies the
+permissions of such files with a special face 'dired-set-id'.
+
+---
+*** A new face, 'dired-special', is used to highlight sockets, named
+pipes, block devices and character devices.
+
** Find-Dired
---
@@ -1068,12 +1068,6 @@ script. The default is nil.
*** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'.
This generates ChangeLog entries from the VC fileset diff.
----
-*** 'vc-dir' now shows a button allowing you to hide the stash list.
-Controlled by user option 'vc-git-show-stash'. Default t means show
-the entire list as before. An integer value limits the list length
-(but still allows you to show the entire list via the button).
-
+++
*** Recording ChangeLog entries doesn't require an actual file.
If a ChangeLog file doesn't exist, and if the new user option
@@ -1084,9 +1078,11 @@ still be used if it exists.) Set the user option to nil
to get the
previous behavior of always creating a buffer that visits a ChangeLog
file.
----
-*** New user option 'vc-find-revision-no-save'.
-With non-nil, 'vc-find-revision' doesn't write the created buffer to file.
++++
+*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode'
+buffers will delete the marked files (or if no files are marked, the
+file under point). This command does not notify the VC backend, and
+is mostly useful for unregistered files.
---
*** 'vc-dir-ignore' now takes a prefix argument to ignore all marked files.
@@ -1102,6 +1098,12 @@ When some files are marked, only those are stashed.
When no files are marked, all modified files are stashed, as before.
---
+*** 'vc-dir' now shows a button allowing you to hide the stash list.
+Controlled by user option 'vc-git-show-stash'. Default t means show
+the entire list as before. An integer value limits the list length
+(but still allows you to show the entire list via the button).
+
+---
*** 'vc-git-stash' is now bound to 'C' in the stash headers.
--
@@ -1133,26 +1135,20 @@ you invoke 'C-x v m' ('vc-merge').
instead of revision numbers as completion candidates when it prompts
for a revision.
-+++
-*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions
-and compares their entire trees.
-
---
*** New user option 'vc-hg-revert-switches'.
It specifies switches to pass to Hg's 'revert' command.
++++
+*** 'C-u C-x v D' ('vc-root-version-diff') prompts for two revisions
+and compares their entire trees.
+
---
*** 'C-x v M D' ('vc-diff-mergebase') and 'C-x v M L' ('vc-log-mergebase')
print diffs and logs between the merge base (common ancestor) of two
given revisions.
+++
-*** The new 'd' command ('vc-dir-clean-files') in 'vc-dir-mode'
-buffers will delete the marked files (or if no files are marked, the
-file under point). This command does not notify the VC backend, and
-is mostly useful for unregistered files.
-
-+++
*** New command 'vc-log-search' asks for a pattern, searches it
in the revision log, and displays matched log entries in the
log buffer. For example, 'M-x vc-log-search RET bug#36644 RET'
@@ -1170,6 +1166,10 @@ revision's commit. (For some less capable VCSes, only
the log entry
is shown.)
---
+*** New user option 'vc-find-revision-no-save'.
+With non-nil, 'vc-find-revision' doesn't write the created buffer to file.
+
+---
*** 'C-x v =' can now mimic Magit's diff format.
Set the new user option 'diff-font-lock-prettify' to t for that, see
below under "Diff mode".
@@ -2084,12 +2084,17 @@ variable for remote shells. It still defaults to
"/bin/sh".
** Single shell commands
+++
-*** 'shell-command-dont-erase-buffer' accepts the value 'erase' to
-force to erase the output buffer before execution of the command.
+*** New values of 'shell-command-dont-erase-buffer'.
+This option can now have the value 'erase' to force to erase the
+output buffer before execution of the command, even if the output goes
+to the current buffer. Additional values 'beg-last-out',
+'end-last-out', and 'save-point' control where to put point in the
+output buffer after inserting the shell-command output.
+---
*** The new functions 'shell-command-save-pos-or-erase' and
'shell-command-set-point-after-cmd' control how point is handled
-between two consecutive shell commands in the same buffer.
+between two consecutive shell commands in the same output buffer.
+++
*** 'async-shell-command-width' defines the number of display columns
@@ -3510,6 +3515,10 @@ functions.
*** 'image-mode' now uses this library to automatically rotate images
according to the orientation in the Exif data, if any.
+*** In 'image-mode' the image is resized automatically to fit in window.
+The image will resize upon first display and whenever the window's
+dimensions change.
+
---
*** New library image-converter.
If you need to view exotic image formats for which Emacs doesn't have
@@ -3547,6 +3556,8 @@ name to the kill ring.
With a prefix argument, 'image-rotate' now rotates the image at point
90 degrees counter-clockwise, instead of the default clockwise.
+*** 'image-mode' has a new key prefix 's' for transformation commands.
+
** Modules
---
diff --git a/lib/ieee754.in.h b/lib/ieee754.in.h
index d64bb46..01ca648 100644
--- a/lib/ieee754.in.h
+++ b/lib/ieee754.in.h
@@ -67,7 +67,7 @@ union ieee754_float
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signalling NaN. */
+ /* This format makes it easier to see if a NaN is a signaling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
@@ -118,7 +118,7 @@ union ieee754_double
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signalling NaN. */
+ /* This format makes it easier to see if a NaN is a signaling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 23f70d1..e40f94c 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -1,4 +1,4 @@
-;;; apropos.el --- apropos commands for users and programmers
+;;; apropos.el --- apropos commands for users and programmers -*-
lexical-binding: t -*-
;; Copyright (C) 1989, 1994-1995, 2001-2020 Free Software Foundation,
;; Inc.
@@ -82,49 +82,41 @@ commands also has an optional argument to request a more
extensive search.
Additionally, this option makes the function `apropos-library'
include key-binding information in its output."
- :group 'apropos
:type 'boolean)
(defface apropos-symbol
'((t (:inherit bold)))
"Face for the symbol name in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-keybinding
'((t (:inherit underline)))
"Face for lists of keybinding in Apropos output."
- :group 'apropos
:version "24.3")
(defface apropos-property
'((t (:inherit font-lock-builtin-face)))
"Face for property name in Apropos output, or nil for none."
- :group 'apropos
:version "24.3")
(defface apropos-function-button
'((t (:inherit (font-lock-function-name-face button))))
"Button face indicating a function, macro, or command in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-variable-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a variable in Apropos."
- :group 'apropos
:version "24.3")
(defface apropos-user-option-button
'((t (:inherit (font-lock-variable-name-face button))))
"Button face indicating a user option in Apropos."
- :group 'apropos
:version "24.4")
(defface apropos-misc-button
'((t (:inherit (font-lock-constant-face button))))
"Button face indicating a miscellaneous object type in Apropos."
- :group 'apropos
:version "24.3")
(defcustom apropos-match-face 'match
@@ -132,14 +124,12 @@ include key-binding information in its output."
This applies when you look for matches in the documentation or variable value
for the pattern; the part that matches gets displayed in this font."
:type '(choice (const nil) face)
- :group 'apropos
:version "24.3")
(defcustom apropos-sort-by-scores nil
"Non-nil means sort matches by scores; best match is shown first.
This applies to all `apropos' commands except `apropos-documentation'.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -148,7 +138,6 @@ If value is `verbose', the computed score is shown for each
match."
"Non-nil means sort matches by scores; best match is shown first.
This applies to `apropos-documentation' only.
If value is `verbose', the computed score is shown for each match."
- :group 'apropos
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "show scores" verbose)))
@@ -160,6 +149,10 @@ If value is `verbose', the computed score is shown for
each match."
;; definition of RET, so that users can use it anywhere in an
;; apropos item, not just on top of a button.
(define-key map "\C-m" 'apropos-follow)
+
+ ;; Movement keys
+ (define-key map "n" 'apropos-next-symbol)
+ (define-key map "p" 'apropos-previous-symbol)
map)
"Keymap used in Apropos mode.")
@@ -348,7 +341,7 @@ before finding a label."
(defun apropos-words-to-regexp (words wild)
- "Make regexp matching any two of the words in WORDS.
+ "Return a regexp matching any two of the words in WORDS.
WILD should be a subexpression matching wildcards between matches."
(setq words (delete-dups (copy-sequence words)))
(if (null (cdr words))
@@ -640,7 +633,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found."
+Return list of symbols and documentation found."
(interactive (list (apropos-read-pattern "symbol")
current-prefix-arg))
(setq apropos--current (list #'apropos pattern do-all))
@@ -917,16 +910,14 @@ Returns list of symbols and documentation found."
(defun apropos-value-internal (predicate symbol function)
- (if (funcall predicate symbol)
- (progn
- (setq symbol (prin1-to-string (funcall function symbol)))
- (if (string-match apropos-regexp symbol)
- (progn
- (if apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- symbol))
- symbol)))))
+ (when (funcall predicate symbol)
+ (setq symbol (prin1-to-string (funcall function symbol)))
+ (when (string-match apropos-regexp symbol)
+ (if apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ symbol))
+ symbol)))
(defun apropos-documentation-internal (doc)
(cond
@@ -948,6 +939,10 @@ Returns list of symbols and documentation found."
doc))))
(defun apropos-format-plist (pl sep &optional compare)
+ "Return a string representation of the plist PL.
+Paired elements are separated by the string SEP. Only include
+properties matching the current `apropos-regexp' when COMPARE is
+non-nil."
(setq pl (symbol-plist pl))
(let (p p-out)
(while pl
@@ -956,13 +951,12 @@ Returns list of symbols and documentation found."
(put-text-property 0 (length (symbol-name (car pl)))
'face 'apropos-property p)
(setq p nil))
- (if p
- (progn
- (and compare apropos-match-face
- (put-text-property (match-beginning 0) (match-end 0)
- 'face apropos-match-face
- p))
- (setq p-out (concat p-out (if p-out sep) p))))
+ (when p
+ (and compare apropos-match-face
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face apropos-match-face
+ p))
+ (setq p-out (concat p-out (if p-out sep) p)))
(setq pl (nthcdr 2 pl)))
p-out))
@@ -1270,6 +1264,21 @@ as a heading."
(or (apropos-next-label-button (line-beginning-position))
(error "There is nothing to follow here"))))
+(defun apropos-next-symbol ()
+ "Move cursor down to the next symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (< (point) (point-max)))
+ (forward-line)))
+
+(defun apropos-previous-symbol ()
+ "Move cursor back to the last symbol in an apropos-mode buffer."
+ (interactive)
+ (forward-line -1)
+ (while (and (not (eq (face-at-point) 'apropos-symbol))
+ (> (point) (point-min)))
+ (forward-line -1)))
(defun apropos-describe-plist (symbol)
"Display a pretty listing of SYMBOL's plist."
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index c0307aa..d415277 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -1,4 +1,4 @@
-;;; autoarg.el --- make digit keys supply prefix args
+;;; autoarg.el --- make digit keys supply prefix args -*- lexical-binding: t
-*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
@@ -59,9 +59,8 @@
;; (define-key autoarg-mode-map [?\r] 'autoarg-terminate)
(defvar autoarg-kp-digits
- (let (alist)
- (dotimes (i 10 alist)
- (push (cons (intern (format "kp-%d" i)) i) alist))))
+ (mapcar (lambda (i) (cons (intern (format "kp-%d" i)) i))
+ (reverse (number-sequence 0 9))))
(defun autoarg-kp-digit-argument (arg)
"Part of the numeric argument for the next command, like `digit-argument'."
diff --git a/lisp/calculator.el b/lisp/calculator.el
index c1af26f..6996990 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -1622,7 +1622,7 @@ To use this, apply a binary operator (evaluate it), then
call this."
(overflow-error
;; X and Y must be integers, as expt silently returns floating-point
;; infinity on floating-point overflow.
- (if (or (natnump x) (zerop (logand x 1)))
+ (if (or (natnump x) (zerop (logand y 1)))
1.0e+INF
-1.0e+INF))))
diff --git a/lisp/cdl.el b/lisp/cdl.el
index adc05f1..c8025a9 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -1,4 +1,4 @@
-;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs
+;;; cdl.el --- Common Data Language (CDL) utility functions for GNU Emacs -*-
lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 2c42a19..a892754 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -1,4 +1,4 @@
-;;; elide-head.el --- hide headers in files
+;;; elide-head.el --- hide headers in files -*- lexical-binding: t; -*-
;; Copyright (C) 1999, 2001-2020 Free Software Foundation, Inc.
@@ -63,12 +63,10 @@ The cars of elements of the list are searched for in order.
Text is
elided with an invisible overlay from the end of the line where the
first match is found to the end of the match for the corresponding
cdr."
- :group 'elide-head
:type '(alist :key-type (regexp :tag "Start regexp")
:value-type (regexp :tag "End regexp")))
-(defvar elide-head-overlay nil)
-(make-variable-buffer-local 'elide-head-overlay)
+(defvar-local elide-head-overlay nil)
;;;###autoload
(defun elide-head (&optional arg)
@@ -108,7 +106,7 @@ This is suitable as an entry on `find-file-hook' or
appropriate mode hooks."
(overlay-put elide-head-overlay 'after-string "...")))))))
(defun elide-head-show ()
- "Show a header elided current buffer by \\[elide-head]."
+ "Show a header in the current buffer elided by \\[elide-head]."
(interactive)
(if (and (overlayp elide-head-overlay)
(overlay-buffer elide-head-overlay))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index b363107..ff84d94 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -700,7 +700,7 @@ Each pair is (NAME . LAP)")
(byte-defop 112 1 byte-current-buffer)
(byte-defop 113 0 byte-set-buffer)
(byte-defop 114 0 byte-save-current-buffer
- "To make a binding to record the current buffer")
+ "to make a binding to record the current buffer")
(byte-defop 115 0 byte-set-mark-OBSOLETE)
(byte-defop 116 1 byte-interactive-p-OBSOLETE)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index b5581aa..e4b8007 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2134,7 +2134,7 @@ buffer, otherwise stop after the first error."
(checkdoc-ispell-init)
(unless checkdoc-spellcheck-documentation-flag
;; this happens when (checkdoc-ispell-init) can't start
`ispell-program-name'
- (user-error "No spellchecker installed: check the variable
`ispell-program-name'."))
+ (user-error "No spellchecker installed: check the variable
`ispell-program-name'"))
(save-excursion
(skip-chars-forward "^a-zA-Z")
(let (word sym case-fold-search err word-beginning word-end)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index bb10194..4408bb5 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -767,7 +767,7 @@ The result of the body appears to the compiler as a quoted
constant."
"Eval EXPR and choose among clauses on that value.
Each clause looks like (KEYLIST BODY...). EXPR is evaluated and
compared against each key in each KEYLIST; the corresponding BODY
-is evaluated. If no clause succeeds, cl-case returns nil. A
+is evaluated. If no clause succeeds, this macro returns nil. A
single non-nil atom may be used in place of a KEYLIST of one
atom. A KEYLIST of t or `otherwise' is allowed only in the final
clause, and matches if no other keys match. Key values are
@@ -806,10 +806,10 @@ compared by `eql'.
;;;###autoload
(defmacro cl-typecase (expr &rest clauses)
- "Evals EXPR, chooses among clauses on that value.
+ "Eval EXPR and choose among clauses on that value.
Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
-cl-typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
+this macro returns nil. A TYPE of t or `otherwise' is allowed only in the
final clause, and matches if no other keys match.
\n(fn EXPR (TYPE BODY...)...)"
(declare (indent 1)
@@ -2701,7 +2701,7 @@ pairs for that slot.
Supported keywords for slots are:
- `:read-only': If this has a non-nil value, that slot cannot be set via
`setf'.
- `:documentation': this is a docstring describing the slot.
-- `:type': the type of the field; currently unused.
+- `:type': the type of the field; currently only used for documentation.
\(fn NAME &optional DOCSTRING &rest SLOTS)"
(declare (doc-string 2) (indent 1)
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 7dd3cbd..f68c0fa 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -238,7 +238,7 @@ FUNSYM must be a symbol of a defined function."
;; The info vector data structure is a 2 element vector. The 0th
;; element is the call-count, i.e. the total number of times this
;; function has been entered. This value is bumped up on entry to
- ;; the function so that non-local exists are still recorded. TBD:
+ ;; the function so that non-local exits are still recorded. TBD:
;; I haven't tested non-local exits at all, so no guarantees.
;;
;; The 1st element is the total amount of time in seconds that has
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index 27ed299..ba344eb 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -59,7 +59,7 @@
;; This raw form of iteration is general, but a bit awkward to use, so
;; this library also provides some convenience functions:
;;
-;; `iter-do' is like `cl-do', except that instead of walking a list,
+;; `iter-do' is like `dolist', except that instead of walking a list,
;; it walks an iterator. `cl-loop' is also extended with a new
;; keyword, `iter-by', that iterates over an iterator.
;;
@@ -67,7 +67,7 @@
;;; Implementation:
;;
-;; The internal cps transformation code uses the cps- namespace.
+;; The internal CPS transformation code uses the cps- namespace.
;; Iteration functions use the `iter-' namespace. Generator functions
;; are somewhat less efficient than conventional elisp routines,
;; although we try to avoid CPS transformation on forms that do not
@@ -89,13 +89,13 @@
`(gensym (format ,fmt ,@args)))
(defvar cps--dynamic-wrappers '(identity)
- "List of transformer functions to apply to atomic forms we
-evaluate in CPS context.")
+ "List of functions to apply to atomic forms.
+These are transformer functions applied to atomic forms evaluated
+in CPS context.")
(defconst cps-standard-special-forms
'(setq setq-default throw interactive)
- "List of special forms that we treat just like ordinary
- function applications." )
+ "List of special forms treated just like ordinary function applications." )
(defun cps--trace-funcall (func &rest args)
(message "%S: args=%S" func args)
@@ -118,17 +118,15 @@ evaluate in CPS context.")
(error "%s not supported in generators" ,function)))
(defmacro cps--with-value-wrapper (wrapper &rest body)
- "Continue generating CPS code with an atomic-form wrapper
-to the current stack of such wrappers. WRAPPER is a function that
-takes a form and returns a wrapped form.
+ "Evaluate BODY with WRAPPER added to the stack of atomic-form wrappers.
+WRAPPER is a function that takes an atomic form and returns a wrapped form.
Whenever we generate an atomic form (i.e., a form that can't
`iter-yield'), we first (before actually inserting that form in our
generated code) pass that form through all the transformer
functions. We use this facility to wrap forms that can transfer
control flow non-locally in goo that diverts this control flow to
-the CPS state machinery.
-"
+the CPS state machinery."
(declare (indent 1))
`(let ((cps--dynamic-wrappers
(cons
@@ -153,7 +151,7 @@ DYNAMIC-VAR bound to STATIC-VAR."
,@body))
(defun cps--add-state (kind body)
- "Create a new CPS state with body BODY and return the state's name."
+ "Create a new CPS state of KIND with BODY and return the state's name."
(declare (indent 1))
(let ((state (cps--gensym "cps-state-%s-" kind)))
(push (list state body cps--cleanup-function) cps--states)
@@ -170,14 +168,12 @@ DYNAMIC-VAR bound to STATIC-VAR."
(and (fboundp handler) handler)))
(defvar cps-inhibit-atomic-optimization nil
- "When non-nil, always rewrite forms into cps even when they
-don't yield.")
+ "When non-nil, always rewrite forms into CPS even when they don't yield.")
(defvar cps--yield-seen)
(defun cps--atomic-p (form)
- "Return whether the given form never yields."
-
+ "Return nil if FORM can yield, non-nil otherwise."
(and (not cps-inhibit-atomic-optimization)
(let* ((cps--yield-seen))
(ignore (macroexpand-all
@@ -649,8 +645,8 @@ modified copy."
(defun iter-yield (value)
"When used inside a generator, yield control to caller.
The caller of `iter-next' receives VALUE, and the next call to
-`iter-next' resumes execution at the previous
-`iter-yield' point."
+`iter-next' resumes execution with the form immediately following this
+`iter-yield' call."
(identity value)
(error "`iter-yield' used outside a generator"))
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 3ab4929..096036a 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -38,7 +38,7 @@
;;
;; Instead, we use here a higher-order approach: instead
;; of a 5-tuple, a place-expander returns a function.
-;; If you think about types, the old approach return things of type
+;; If you think about types, the old approach returns things of type
;; {vars: List Var, values: List Exp,
;; stores: List Var, getter: Exp, setter: Exp}
;; whereas the new approach returns a function of type
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 3b0f549..98c4416 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -535,7 +535,7 @@ This will generate compile-time constants from BINDINGS."
;; Support backtrace mode.
(defconst lisp-el-font-lock-keywords-for-backtraces lisp-el-font-lock-keywords
- "Default highlighting from Emacs Lisp mod used in Backtrace mode.")
+ "Default highlighting from Emacs Lisp mode used in Backtrace mode.")
(defconst lisp-el-font-lock-keywords-for-backtraces-1
lisp-el-font-lock-keywords-1
"Subdued highlighting from Emacs Lisp mode used in Backtrace mode.")
(defconst lisp-el-font-lock-keywords-for-backtraces-2
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index cc5226b..cfde84e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -33,17 +33,8 @@
;;; Commentary:
;; ERC is a powerful, modular, and extensible IRC client for Emacs.
-
-;; For more information, see the following URLs:
-;; * https://sv.gnu.org/projects/erc/
-;; * https://www.emacswiki.org/emacs/ERC
-
-
-
-;; As of 2006-06-13, ERC development is now hosted on Savannah
-;; (https://sv.gnu.org/projects/erc). I invite everyone who wants to
-;; hack on it to contact me <address@hidden> in order to get write
-;; access to the shared Arch archive.
+;; For more information, visit the ERC page at
+;; <https://www.gnu.org/software/emacs/erc.html>.
;; Configuration:
@@ -75,12 +66,12 @@
(eval-when-compile (require 'subr-x))
(defvar erc-official-location
- "https://www.emacswiki.org/emacs/ERC (mailing list: address@hidden)"
+ "https://www.gnu.org/software/emacs/erc.html (mailing list: address@hidden)"
"Location of the ERC client on the Internet.")
(defgroup erc nil
"Emacs Internet Relay Chat client."
- :link '(url-link "https://www.emacswiki.org/emacs/ERC";)
+ :link '(url-link "https://www.gnu.org/software/emacs/erc.html";)
:link '(custom-manual "(erc) Top")
:prefix "erc-"
:group 'applications)
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 6be6d11..02d9060 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -1247,8 +1247,8 @@ If SEND-IF-FORCE, only send authinfo to the server if the
(and nntp-connection-timeout
(run-at-time
nntp-connection-timeout nil
- `(lambda ()
- (nntp-kill-buffer ,pbuffer)))))
+ (lambda ()
+ (nntp-kill-buffer pbuffer)))))
(process
(condition-case err
(let ((coding-system-for-read 'binary)
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index bf79e48..08d8217 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -567,8 +567,9 @@ in which case the highlighting will not update as you type."
(let* ((faces-after (get-text-property (point) 'face))
(faces-before
(unless (bobp) (get-text-property (1- (point)) 'face)))
- (faces-after (if (consp faces-after) faces-after (list
faces-after)))
- (faces-before (if (consp faces-before) faces-before (list
faces-before)))
+ ;; Use proper-list-p to handle faces like (foreground-color .
"red3")
+ (faces-after (if (proper-list-p faces-after) faces-after (list
faces-after)))
+ (faces-before (if (proper-list-p faces-before) faces-before (list
faces-before)))
(faces (mapcar #'hi-lock-keyword->face
hi-lock-interactive-patterns))
(face-after (seq-some (lambda (face) (car (memq face faces)))
faces-after))
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 66bc731..c12f390 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -300,7 +300,7 @@ if that doesn't produce a completion match."
(interactive)
(if (and (eq (char-before) ?/)
(eq (icomplete--category) 'file))
- (backward-kill-sexp 1)
+ (zap-up-to-char -1 ?/)
(call-interactively 'backward-delete-char)))
(defvar icomplete-fido-mode-map
@@ -329,6 +329,7 @@ if that doesn't produce a completion match."
icomplete-show-matches-on-no-input t
icomplete-hide-common-prefix nil
completion-styles '(flex)
+ completion-flex-nospace nil
completion-category-defaults nil)))
;;;###autoload
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 22d7d91..fbce119 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -418,24 +418,40 @@ call."
(defvar image-mode-map
(let ((map (make-sparse-keymap)))
+
+ ;; Toggling keys
(define-key map "\C-c\C-c" 'image-toggle-display)
(define-key map "\C-c\C-x" 'image-toggle-hex-display)
- (define-key map (kbd "SPC") 'image-scroll-up)
- (define-key map (kbd "S-SPC") 'image-scroll-down)
- (define-key map (kbd "DEL") 'image-scroll-down)
- (define-key map (kbd "RET") 'image-toggle-animation)
+
+ ;; Transformation keys
+ (define-key map "sf" 'image-mode-fit-frame)
+ (define-key map "sh" 'image-transform-fit-to-height)
+ (define-key map "sw" 'image-transform-fit-to-width)
+ (define-key map "sr" 'image-transform-set-rotation)
+ (define-key map "s0" 'image-transform-reset)
+ (define-key map "ss" 'image-transform-set-scale)
+
+ ;; Multi-frame keys
+ (define-key map (kbd "RET") 'image-toggle-animation)
(define-key map "F" 'image-goto-frame)
(define-key map "f" 'image-next-frame)
(define-key map "b" 'image-previous-frame)
- (define-key map "n" 'image-next-file)
- (define-key map "p" 'image-previous-file)
(define-key map "a+" 'image-increase-speed)
(define-key map "a-" 'image-decrease-speed)
(define-key map "a0" 'image-reset-speed)
(define-key map "ar" 'image-reverse-speed)
+
+ ;; File keys
+ (define-key map "n" 'image-next-file)
+ (define-key map "p" 'image-previous-file)
(define-key map "w" 'image-mode-copy-file-name-as-kill)
(define-key map "m" 'image-mode-mark-file)
(define-key map "u" 'image-mode-unmark-file)
+
+ ;; Scrolling keys
+ (define-key map (kbd "SPC") 'image-scroll-up)
+ (define-key map (kbd "S-SPC") 'image-scroll-down)
+ (define-key map (kbd "DEL") 'image-scroll-down)
(define-key map [remap forward-char] 'image-forward-hscroll)
(define-key map [remap backward-char] 'image-backward-hscroll)
(define-key map [remap right-char] 'image-forward-hscroll)
@@ -452,6 +468,7 @@ call."
(define-key map [remap move-end-of-line] 'image-eol)
(define-key map [remap beginning-of-buffer] 'image-bob)
(define-key map [remap end-of-buffer] 'image-eob)
+
(easy-menu-define image-mode-menu map "Menu for Image mode."
'("Image"
["Show as Text" image-toggle-display :active t
@@ -459,17 +476,15 @@ call."
["Show as Hex" image-toggle-hex-display :active t
:help "Show image as hex"]
"--"
+ ["Fit Frame to Image" image-mode-fit-frame :active t
+ :help "Resize frame to match image"]
["Fit to Window Height" image-transform-fit-to-height
- :visible (eq image-type 'imagemagick)
:help "Resize image to match the window height"]
["Fit to Window Width" image-transform-fit-to-width
- :visible (eq image-type 'imagemagick)
:help "Resize image to match the window width"]
["Rotate Image..." image-transform-set-rotation
- :visible (eq image-type 'imagemagick)
:help "Rotate the image"]
["Reset Transformations" image-transform-reset
- :visible (eq image-type 'imagemagick)
:help "Reset all image transformations"]
"--"
["Show Thumbnails"
@@ -486,9 +501,6 @@ call."
:active buffer-file-name
:help "Copy the current file name to the kill ring"]
"--"
- ["Fit Frame to Image" image-mode-fit-frame :active t
- :help "Resize frame to match image"]
- "--"
["Animate Image" image-toggle-animation :style toggle
:selected (let ((image (image-get-display-property)))
(and image (image-animate-timer image)))
@@ -767,11 +779,12 @@ was inserted."
props image)
;; Get the rotation data from the file, if any.
- (setq image-transform-rotation
- (or (exif-orientation
- (ignore-error exif-error
- (exif-parse-buffer)))
- 0.0))
+ (when (zerop image-transform-rotation) ; don't reset modified value
+ (setq image-transform-rotation
+ (or (exif-orientation
+ (ignore-error exif-error
+ (exif-parse-buffer)))
+ 0.0)))
;; :scale 1: If we do not set this, create-image will apply
;; default scaling based on font size.
@@ -1250,8 +1263,7 @@ Do this for an image of type `imagemagick' to make sure
that the
elisp code matches the way ImageMagick computes the bounding box
of a rotated image."
(when (and (not (numberp image-transform-resize))
- (boundp 'image-type)
- (eq image-type 'imagemagick))
+ (boundp 'image-type))
(let ((size (image-display-size (image-get-display-property) t)))
(cond ((eq image-transform-resize 'fit-width)
(cl-assert (= (car size)
@@ -1268,10 +1280,7 @@ of a rotated image."
"Return rescaling/rotation properties for image SPEC.
These properties are determined by the Image mode variables
`image-transform-resize' and `image-transform-rotation'. The
-return value is suitable for appending to an image spec.
-
-Rescaling and rotation properties only take effect if Emacs is
-compiled with ImageMagick support."
+return value is suitable for appending to an image spec."
(setq image-transform-scale 1.0)
(when (or image-transform-resize
(/= image-transform-rotation 0.0))
@@ -1302,41 +1311,32 @@ compiled with ImageMagick support."
(list :rotation image-transform-rotation))))))
(defun image-transform-set-scale (scale)
- "Prompt for a number, and resize the current image by that amount.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
+ "Prompt for a number, and resize the current image by that amount."
(interactive "nScale: ")
(setq image-transform-resize scale)
(image-toggle-display-image))
(defun image-transform-fit-to-height ()
- "Fit the current image to the height of the current window.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
+ "Fit the current image to the height of the current window."
(interactive)
(setq image-transform-resize 'fit-height)
(image-toggle-display-image))
(defun image-transform-fit-to-width ()
- "Fit the current image to the width of the current window.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
+ "Fit the current image to the width of the current window."
(interactive)
(setq image-transform-resize 'fit-width)
(image-toggle-display-image))
(defun image-transform-set-rotation (rotation)
"Prompt for an angle ROTATION, and rotate the image by that amount.
-ROTATION should be in degrees. This command has no effect unless
-Emacs is compiled with ImageMagick support."
+ROTATION should be in degrees."
(interactive "nRotation angle (in degrees): ")
(setq image-transform-rotation (float (mod rotation 360)))
(image-toggle-display-image))
(defun image-transform-reset ()
- "Display the current image with the default size and rotation.
-This command has no effect unless Emacs is compiled with
-ImageMagick support."
+ "Display the current image with the default size and rotation."
(interactive)
(setq image-transform-resize nil
image-transform-rotation 0.0
diff --git a/lisp/image/exif.el b/lisp/image/exif.el
index 065456d..6aeb52c 100644
--- a/lisp/image/exif.el
+++ b/lisp/image/exif.el
@@ -95,7 +95,7 @@ mirrored or not.")
"Parse FILE (a JPEG file) and return the Exif data, if any.
The return value is a list of Exif items.
-If the data is invalid, an `exif-error' is signalled."
+If the data is invalid, an `exif-error' is signaled."
(with-temp-buffer
(set-buffer-multibyte nil)
(insert-file-contents-literally file)
@@ -105,7 +105,7 @@ If the data is invalid, an `exif-error' is signalled."
"Parse BUFFER (which should be a JPEG file) and return the Exif data, if any.
The return value is a list of Exif items.
-If the data is invalid, an `exif-error' is signalled."
+If the data is invalid, an `exif-error' is signaled."
(setq buffer (or buffer (current-buffer)))
(with-current-buffer buffer
(if enable-multibyte-characters
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index caa5747..5cc10b1 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -75,7 +75,7 @@ unless the display width of STR is equal to or less than the
display
width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
defaults to `truncate-string-ellipsis'.
-If ELLIPSIS-TEXT-PROPERTY in non-nil, a too-long string will not
+If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not
be truncated, but instead the elided parts will be covered by a
`display' text property showing the ellipsis."
(or start-column
diff --git a/lisp/json.el b/lisp/json.el
index 055f3f5..6f3b791 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -736,7 +736,7 @@ you will get the following structure returned:
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
-`json-error' is signalled."
+`json-error' is signaled."
(cond ((memq object (list t json-null json-false))
(json-encode-keyword object))
((stringp object) (json-encode-string object))
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index 10dc78d..e1f238c 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -27873,7 +27873,7 @@ Directory for additional secondary Rmail files.")
(custom-autoload 'rmail-secondary-file-directory "rmail" t)
-(defvar rmail-secondary-file-regexp (purecopy "\\.xmail$") "\
+(defvar rmail-secondary-file-regexp (purecopy "\\.xmail\\'") "\
Regexp for which files are secondary Rmail files.")
(custom-autoload 'rmail-secondary-file-regexp "rmail" t)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 3c8202c..d2c3f90 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -163,8 +163,8 @@ perform completion, no matter what ACTION is.
If ACTION is `metadata' or a list where the first element is
`boundaries', return nil. If ACTION is nil, this function works
-like `try-completion'; if it's t, this function works like
-`all-completion'; and any other values makes it work like
+like `try-completion'; if it is t, this function works like
+`all-completion'; and any other value makes it work like
`test-completion'."
(cond
((functionp collection) (funcall collection string predicate action))
@@ -3611,7 +3611,7 @@ that is non-nil."
;;; "flex" completion, also known as flx/fuzzy/scatter completion
;; Completes "foo" to "frodo" and "farfromsober"
-(defcustom completion-flex-nospace t
+(defcustom completion-flex-nospace nil
"Non-nil if `flex' completion rejects spaces in search pattern."
:version "27.1"
:type 'boolean)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 526c564..f19e510 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -912,7 +912,9 @@ or `dbus-call-method-asynchronously'."
#'dbus-call-method #'dbus-call-method-asynchronously))
(args (append (list ,bus ,service ,path ,interface ,method)
(if ,synchronous (list ,@args) (list 'ignore ,@args)))))
- (tramp-dbus-function ,vec func args)))
+ ;; We use `dbus-ignore-errors', because this macro is also called
+ ;; when loading.
+ (dbus-ignore-errors (tramp-dbus-function ,vec func args))))
(font-lock-add-keywords 'emacs-lisp-mode
'("\\<with-tramp-dbus-call-method\\>"))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 95425cb..a39d503 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3577,33 +3577,30 @@ STDERR can also be a file name."
;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache.
- (let ((vc-handled-backends vc-handled-backends)
+ (let ((vc-handled-backends (copy-sequence vc-handled-backends))
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
;; process calls.
(when (and
(memq 'Bzr vc-handled-backends)
- (not (and
- (bound-and-true-p vc-bzr-program)
- (with-tramp-connection-property v vc-bzr-program
- (tramp-find-executable
- v vc-bzr-program (tramp-get-remote-path v))))))
+ (or (not (require 'vc-bzr nil 'noerror))
+ (not (with-tramp-connection-property v vc-bzr-program
+ (tramp-find-executable
+ v vc-bzr-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
(when (and
(memq 'Git vc-handled-backends)
- (not (and
- (bound-and-true-p vc-git-program)
- (with-tramp-connection-property v vc-git-program
- (tramp-find-executable
- v vc-git-program (tramp-get-remote-path v))))))
+ (or (not (require 'vc-git nil 'noerror))
+ (not (with-tramp-connection-property v vc-git-program
+ (tramp-find-executable
+ v vc-git-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Git vc-handled-backends)))
(when (and
(memq 'Hg vc-handled-backends)
- (not (and
- (bound-and-true-p vc-hg-program)
- (with-tramp-connection-property v vc-hg-program
- (tramp-find-executable
- v vc-hg-program (tramp-get-remote-path v))))))
+ (or (not (require 'vc-hg nil 'noerror))
+ (not (with-tramp-connection-property v vc-hg-program
+ (tramp-find-executable
+ v vc-hg-program (tramp-get-remote-path v))))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
(tramp-with-demoted-errors
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index d361db4..e0f5e05 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -75,12 +75,23 @@
;;;###tramp-autoload
(defcustom tramp-smb-conf "/dev/null"
- "Path of the smb.conf file.
-If it is nil, no smb.conf will be added to the `tramp-smb-program'
+ "Path of the \"smb.conf\" file.
+If it is nil, no \"smb.conf\" will be added to the `tramp-smb-program'
call, letting the SMB client use the default one."
:group 'tramp
:type '(choice (const nil) (file :must-match t)))
+;;;###tramp-autoload
+(defcustom tramp-smb-options nil
+ "List of additional options.
+They are added to the `tramp-smb-program' call via \"--option '...'\".
+
+For example, if the deprecated SMB1 protocol shall be used, add to
+this variable (\"client min protocol=NT1\") ."
+ :group 'tramp
+ :type '(repeat string)
+ :version "28.1")
+
(defvar tramp-smb-version nil
"Version string of the SMB client.")
@@ -460,7 +471,8 @@ pass to the OPERATION."
(expand-file-name
tramp-temp-name-prefix
(tramp-compat-temporary-file-directory))))
- (args (list (concat "//" host "/" share) "-E")))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@@ -470,6 +482,10 @@ pass to the OPERATION."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(setq args
(if t1
;; Source is remote.
@@ -760,7 +776,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(let* ((share (tramp-smb-get-share v))
(localname (replace-regexp-in-string
"\\\\" "/" (tramp-smb-get-localname v)))
- (args (list (concat "//" host "/" share) "-E")))
+ (args (list (concat "//" host "/" share) "-E"))
+ (options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@@ -770,6 +787,10 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
@@ -1412,7 +1433,8 @@ component is used as the target of the symlink."
"\\\\" "/" (tramp-smb-get-localname v)))
(args (list (concat "//" host "/" share) "-E" "-S"
(replace-regexp-in-string
- "\n" "," acl-string))))
+ "\n" "," acl-string)))
+ (options tramp-smb-options))
(if (not (zerop (length user)))
(setq args (append args (list "-U" user)))
@@ -1422,6 +1444,10 @@ component is used as the target of the symlink."
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(setq
args
(append args (list (tramp-unquote-shell-quote-argument localname)
@@ -1947,6 +1973,7 @@ If ARGUMENT is non-nil, use it as argument for
(host (tramp-file-name-host vec))
(domain (tramp-file-name-domain vec))
(port (tramp-file-name-port vec))
+ (options tramp-smb-options)
args)
(cond
@@ -1965,6 +1992,10 @@ If ARGUMENT is non-nil, use it as argument for
(when port (setq args (append args (list "-p" port))))
(when tramp-smb-conf
(setq args (append args (list "-s" tramp-smb-conf))))
+ (while options
+ (setq args
+ (append args `("--option" ,(format "%s" (car options))))
+ options (cdr options)))
(when argument
(setq args (append args (list argument))))
diff --git a/lisp/obsolete/cl.el b/lisp/obsolete/cl.el
index 1da4289..20bffff 100644
--- a/lisp/obsolete/cl.el
+++ b/lisp/obsolete/cl.el
@@ -509,7 +509,7 @@ This method shows how to handle `setf's to places of the
form
ARGLIST, as if NAME were going to be expanded as a macro, then
the BODY forms are executed and must return a list of five elements:
a temporary-variables list, a value-forms list, a store-variables list
-\(of length one), a store-form, and an access- form.
+\(of length one), a store-form, and an access-form.
See `gv-define-expander', and `gv-define-setter' for better and
simpler ways to define setf-methods."
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index ad00ee0..837c18f 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -126,7 +126,7 @@ The terminal should shortly flicker."
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
;; do something, otherwise this will be optimized away
- (format "org-babel-screen: File not readable yet."))
+ (sit-for 0.1))
(setq tmp-string (with-temp-buffer
(insert-file-contents-literally tmpfile)
(buffer-substring (point-min) (point-max))))
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 8927b1c..abba299 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -2005,7 +2005,7 @@ the table and kill the editing buffer."
text)
(goto-char (point-min))
(while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
- (while (re-search-forward "[ \t]*\\(?:\n[ \t]*\\)+" nil t)
+ (while (re-search-forward "[ \t]*\n[ \t\n]*" nil t)
(replace-match " "))
(setq text (org-trim (buffer-string)))
(set-window-configuration cw)
diff --git a/lisp/simple.el b/lisp/simple.el
index abf5ee2..8bc84a9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -3474,20 +3474,22 @@ This affects `shell-command' and `async-shell-command'."
:version "27.1")
(defcustom shell-command-dont-erase-buffer nil
- "Control if the output buffer is erased before the command.
+ "Whether to erase the output buffer before executing shell command.
A nil value erases the output buffer before execution of the
shell command, except when the output buffer is the current one.
The value `erase' ensures the output buffer is erased before
-execution of the shell command.
+execution of the shell command even if it is the current buffer.
-Other non-nil values prevent the output buffer from being erased and
-set the point after execution of the shell command.
+Other non-nil values prevent the output buffer from being erased; they
+also reposition point in the shell output buffer after execution of the
+shell command, except when the output buffer is the current buffer.
-The value `beg-last-out' sets point at the beginning of the output,
-`end-last-out' sets point at the end of the buffer, `save-point'
-restores the buffer position before the command."
+The value `beg-last-out' sets point at the beginning of the last
+output, `end-last-out' sets point at the end of the last output,
+and `save-point' restores the buffer position as it was before the
+shell command."
:type '(choice
(const :tag "Erase output buffer if not the current one" nil)
(const :tag "Always erase output buffer" erase)
@@ -3517,9 +3519,12 @@ See `shell-command-dont-erase-buffer'."
;; if some text has a non-nil read-only property,
;; which comint sometimes adds for prompts.
(setq pos
- (cond ((eq sym 'save-point) (point))
- ((eq sym 'beg-last-out) (point-max))
- ;;((not sym)
+ (cond ((eq sym 'save-point)
+ (if (not output-to-current-buffer)
+ (point)))
+ ((eq sym 'beg-last-out)
+ (if (not output-to-current-buffer)
+ (point-max)))
((or (eq sym 'erase)
(and (null sym) (not output-to-current-buffer)))
(let ((inhibit-read-only t))
@@ -3634,10 +3639,15 @@ says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer
and insert the output there; a non-nil value of
`shell-command-dont-erase-buffer' prevents the buffer from being
-erased. If OUTPUT-BUFFER is not a buffer and not nil, insert the
+erased. If OUTPUT-BUFFER is not a buffer and not nil (which happens
+interactively when the prefix argument is given), insert the
output in current buffer after point leaving mark after it. This
cannot be done asynchronously.
+The user option `shell-command-dont-erase-buffer', which see, controls
+whether the output buffer is erased and where to put point after
+the shell command.
+
If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
the output can be displayed in the echo area or in its buffer.
@@ -3725,8 +3735,7 @@ impose the use of a shell (with its need to quote
arguments)."
;; because we inserted text.
(goto-char (prog1 (mark t)
(set-marker (mark-marker) (point)
- (current-buffer))))
- (shell-command-set-point-after-cmd))
+ (current-buffer)))))
;; Output goes in a separate buffer.
;; Preserve the match data in case called from a program.
;; FIXME: It'd be ridiculous for an Elisp function to call
diff --git a/lisp/sort.el b/lisp/sort.el
index e4ff2af..de0e1b9 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -198,7 +198,8 @@ as start and end positions), and with `string<' otherwise."
;;;###autoload
(defun sort-lines (reverse beg end)
- "Sort lines in region alphabetically; argument means descending order.
+ "Sort lines in region alphabetically; REVERSE non-nil means descending order.
+Interactively, REVERSE is the prefix argument, and BEG and END are the region.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
diff --git a/lisp/startup.el b/lisp/startup.el
index 5af264e..bff1000 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -352,11 +352,11 @@ Setting `init-file-user' does not prevent Emacs from
loading
(defcustom site-run-file (purecopy "site-start")
"File containing site-wide run-time initializations.
-This file is loaded at run-time before `~/.emacs'. It contains inits
-that need to be in place for the entire site, but which, due to their
-higher incidence of change, don't make sense to put into Emacs's
+This file is loaded at run-time before `user-init-file'. It contains
+inits that need to be in place for the entire site, but which, due to
+their higher incidence of change, don't make sense to put into Emacs's
dump file. Thus, the run-time load order is: 1. file described in
-this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
+this variable, if non-nil; 2. `user-init-file'; 3. `default.el'.
Don't use the `site-start.el' file for things some users may not like.
Put them in `default.el' instead, so that users can more easily
diff --git a/lisp/strokes.el b/lisp/strokes.el
index 7c00305..08a3818 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1375,9 +1375,7 @@ If STROKES-MAP is not given, `strokes-global-map' will be
used instead."
(defun strokes-alphabetic-lessp (stroke1 stroke2)
"Return t if STROKE1's command name precedes STROKE2's in lexicographic
order."
- (let ((command-name-1 (symbol-name (cdr stroke1)))
- (command-name-2 (symbol-name (cdr stroke2))))
- (string-lessp command-name-1 command-name-2)))
+ (string-lessp (cdr stroke1) (cdr stroke2)))
(defvar strokes-mode-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/subr.el b/lisp/subr.el
index c8eb127..0067665 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -385,7 +385,7 @@ entry to the debugger, even when `debug-on-error' is
non-nil.
This can be overridden by `debug-ignored-errors'.
To signal with MESSAGE without interpreting format characters
-like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE).
+like `%', `\\=`' and `\\='', use (user-error \"%s\" MESSAGE).
In Emacs, the convention is that error messages start with a capital
letter but *do not* end with a period. Please follow this convention
for the sake of consistency."
@@ -3314,7 +3314,7 @@ alternatives."
(defun function-get (f prop &optional autoload)
"Return the value of property PROP of function F.
-If AUTOLOAD is non-nil and F is autoloaded, try to autoload it
+If AUTOLOAD is non-nil and F is autoloaded, try to load it
in the hope that it will set PROP. If AUTOLOAD is `macro', do it only
if it's an autoloaded macro."
(let ((val nil))
@@ -5021,7 +5021,7 @@ The properties used on SYMBOL are `composefunc',
`sendfunc',
(defun backtrace-frames (&optional base)
"Collect all frames of current backtrace into a list.
If non-nil, BASE should be a function, and frames before its
-nearest activation frames are discarded."
+nearest activation frame are discarded."
(let ((frames nil))
(mapbacktrace (lambda (&rest frame) (push frame frames))
(or base 'backtrace-frames))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index a9fbd2f..65f6164 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -800,8 +800,8 @@ Otherwise returns the library directory name, if that is
defined."
(defun ispell-create-debug-buffer (&optional append)
"Create an ispell debug buffer for debugging output.
-If APPEND is non-nil, append the info to previous buffer if exists,
-otherwise is reset. Returns name of ispell debug buffer.
+If APPEND is non-nil, add output to the old buffer if it exists,
+otherwise the buffer is erased first. Returns the debug buffer.
See `ispell-buffer-with-debug' for an example of use."
(let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*")))
(with-current-buffer ispell-debug-buffer
@@ -812,7 +812,7 @@ See `ispell-buffer-with-debug' for an example of use."
ispell-debug-buffer))
(defsubst ispell-print-if-debug (format &rest args)
- "Print message using FORMAT and ARGS to `ispell-debug-buffer' buffer if
enabled."
+ "Print message using FORMAT and ARGS to `ispell-debug-buffer' if enabled."
(if (boundp 'ispell-debug-buffer)
(with-current-buffer ispell-debug-buffer
(goto-char (point-max))
@@ -3618,8 +3618,8 @@ Returns the sum SHIFT due to changes in word
replacements."
;;;###autoload
(defun ispell-buffer-with-debug (&optional append)
- "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
-If APPEND is non-n il, append the info to previous buffer if exists."
+ "`ispell-buffer' with some output sent to `ispell-debug-buffer'.
+If APPEND is non-nil, don't erase previous debugging output."
(interactive)
(let ((ispell-debug-buffer (ispell-create-debug-buffer append)))
(ispell-buffer)))
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 1cce2c3..cbe35ea 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -440,6 +440,7 @@ extern int alarm (int);
extern int sys_kill (pid_t, int);
+extern void explicit_bzero (void *, size_t);
/* For integration with MSDOS support. */
#define getdisk() (_getdrive () - 1)
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index 2271eef..2e898c7 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -109,6 +109,7 @@ ac_cv_func_futimens=not-needed
gl_cv_func_futimens_works="not-needed-so-yes"
ac_cv_func_utimensat=yes
gl_cv_func_utimensat_works=yes
+ac_cv_func_explicit_bzero=yes
# Aliased to _commit in ms-w32.h
ac_cv_func_fsync=yes
ac_cv_func_fdatasync=yes
diff --git a/src/bidi.c b/src/bidi.c
index 3abde7f..1017bd2 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -109,7 +109,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
-------------------
In a nutshell, fetching the next character boils down to calling
- STRING_CHAR_AND_LENGTH, passing it the address of a buffer or
+ string_char_and_length, passing it the address of a buffer or
string position. See bidi_fetch_char. However, if the next
character is "covered" by a display property of some kind,
bidi_fetch_char returns the u+FFFC "object replacement character"
@@ -1269,7 +1269,6 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t *disp_pos,
ptrdiff_t endpos
= (string->s || STRINGP (string->lstring)) ? string->schars : ZV;
struct text_pos pos;
- int len;
/* If we got past the last known position of display string, compute
the position of the next one. That position could be at CHARPOS. */
@@ -1341,10 +1340,10 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t *disp_pos,
normal_char:
if (string->s)
{
-
if (!string->unibyte)
{
- ch = STRING_CHAR_AND_LENGTH (string->s + bytepos, len);
+ int len;
+ ch = string_char_and_length (string->s + bytepos, &len);
*ch_len = len;
}
else
@@ -1357,8 +1356,9 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t *disp_pos,
{
if (!string->unibyte)
{
- ch = STRING_CHAR_AND_LENGTH (SDATA (string->lstring) + bytepos,
- len);
+ int len;
+ ch = string_char_and_length (SDATA (string->lstring) + bytepos,
+ &len);
*ch_len = len;
}
else
@@ -1369,9 +1369,11 @@ bidi_fetch_char (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t *disp_pos,
}
else
{
- ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (bytepos), len);
+ int len;
+ ch = string_char_and_length (BYTE_POS_ADDR (bytepos), &len);
*ch_len = len;
}
+
*nchars = 1;
}
@@ -1550,7 +1552,7 @@ bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t
pos_byte)
display string? And what if a display string covering some
of the text over which we scan back includes
paragraph_start_re? */
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
if (bpc && region_cache_backward (cache_buffer, bpc, pos, &next))
{
pos = next, pos_byte = CHAR_TO_BYTE (pos);
@@ -1763,7 +1765,7 @@ bidi_paragraph_init (bidi_dir_t dir, struct bidi_it
*bidi_it, bool no_default_p)
/* FXIME: What if p is covered by a display
string? See also a FIXME inside
bidi_find_paragraph_start. */
- DEC_BOTH (p, pbyte);
+ dec_both (&p, &pbyte);
prevpbyte = bidi_find_paragraph_start (p, pbyte);
}
pstartbyte = prevpbyte;
diff --git a/src/buffer.c b/src/buffer.c
index f3532a8..53b3bd9 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -2308,7 +2308,7 @@ advance_to_char_boundary (ptrdiff_t byte_pos)
c = FETCH_BYTE (byte_pos);
}
while (! CHAR_HEAD_P (c) && byte_pos > BEG);
- INC_POS (byte_pos);
+ byte_pos += next_char_len (byte_pos);
if (byte_pos < orig_byte_pos)
byte_pos = orig_byte_pos;
/* If C is a constituent of a multibyte sequence, BYTE_POS was
@@ -2552,8 +2552,6 @@ current buffer is cleared. */)
p = BEG_ADDR;
while (1)
{
- int c, bytes;
-
if (pos == stop)
{
if (pos == Z)
@@ -2565,7 +2563,7 @@ current buffer is cleared. */)
p++, pos++;
else if (CHAR_BYTE8_HEAD_P (*p))
{
- c = STRING_CHAR_AND_LENGTH (p, bytes);
+ int bytes, c = string_char_and_length (p, &bytes);
/* Delete all bytes for this 8-bit character but the
last one, and change the last one to the character
code. */
@@ -2582,7 +2580,7 @@ current buffer is cleared. */)
}
else
{
- bytes = BYTES_BY_CHAR_HEAD (*p);
+ int bytes = BYTES_BY_CHAR_HEAD (*p);
p += bytes, pos += bytes;
}
}
@@ -2636,8 +2634,7 @@ current buffer is cleared. */)
if (ASCII_CHAR_P (*p))
p++, pos++;
else if (EQ (flag, Qt)
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (bytes = MULTIBYTE_LENGTH (p, pend)) > 0)
+ && 0 < (bytes = multibyte_length (p, pend, true, false)))
p += bytes, pos += bytes;
else
{
diff --git a/src/buffer.h b/src/buffer.h
index abb1294..3da4941 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1523,6 +1523,146 @@ lowercasep (int c)
return !uppercasep (c) && upcase (c) != c;
}
+/* Return a non-outlandish value for the tab width. */
+
+INLINE int
+sanitize_tab_width (Lisp_Object width)
+{
+ return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000
+ ? XFIXNUM (width) : 8);
+}
+
+INLINE int
+SANE_TAB_WIDTH (struct buffer *buf)
+{
+ return sanitize_tab_width (BVAR (buf, tab_width));
+}
+
+/* Return a non-outlandish value for a character width. */
+
+INLINE int
+sanitize_char_width (EMACS_INT width)
+{
+ return 0 <= width && width <= 1000 ? width : 1000;
+}
+
+/* Return the width of character C. The width is measured by how many
+ columns C will occupy on the screen when displayed in the current
+ buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
+ CHAR_WIDTH. */
+
+INLINE int
+CHARACTER_WIDTH (int c)
+{
+ return (0x20 <= c && c < 0x7f ? 1
+ : 0x7f < c ? (sanitize_char_width
+ (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
+ : c == '\t' ? SANE_TAB_WIDTH (current_buffer)
+ : c == '\n' ? 0
+ : !NILP (BVAR (current_buffer, ctl_arrow)) ? 2 : 4);
+}
+
+
+/* Like fetch_string_char_advance, but fetch character from the current
+ buffer. */
+
+INLINE int
+fetch_char_advance (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = *chp;
+ b++;
+ }
+ *charidx = c;
+ *byteidx = b;
+ return output;
+}
+
+
+/* Like fetch_char_advance, but assumes the current buffer is multibyte. */
+
+INLINE int
+fetch_char_advance_no_check (ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t c = *charidx, b = *byteidx;
+ c++;
+ unsigned char *chp = BYTE_POS_ADDR (b);
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ *charidx = c;
+ *byteidx = b;
+ return output;
+}
+
+/* Return the number of bytes in the multibyte character in BUF
+ that starts at position POS_BYTE. This relies on the fact that
+ *GPT_ADDR and *Z_ADDR are always accessible and the values are
+ '\0'. No range checking of POS_BYTE. */
+
+INLINE int
+buf_next_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+{
+ unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte);
+ return BYTES_BY_CHAR_HEAD (*chp);
+}
+
+INLINE int
+next_char_len (ptrdiff_t pos_byte)
+{
+ return buf_next_char_len (current_buffer, pos_byte);
+}
+
+/* Return the number of bytes in the multibyte character in BUF just
+ before POS_BYTE. No range checking of POS_BYTE. */
+
+INLINE int
+buf_prev_char_len (struct buffer *buf, ptrdiff_t pos_byte)
+{
+ unsigned char *chp
+ = (BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE
+ + (pos_byte <= BUF_GPT_BYTE (buf) ? 0 : BUF_GAP_SIZE (buf)));
+ return raw_prev_char_len (chp);
+}
+
+INLINE int
+prev_char_len (ptrdiff_t pos_byte)
+{
+ return buf_prev_char_len (current_buffer, pos_byte);
+}
+
+/* Increment both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+INLINE void
+inc_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+{
+ (*charpos)++;
+ (*bytepos) += (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? next_char_len (*bytepos) : 1);
+}
+
+/* Decrement both *CHARPOS and *BYTEPOS, each in the appropriate way. */
+
+INLINE void
+dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
+{
+ (*charpos)--;
+ (*bytepos) -= (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? prev_char_len (*bytepos) : 1);
+}
+
INLINE_HEADER_END
#endif /* EMACS_BUFFER_H */
diff --git a/src/bytecode.c b/src/bytecode.c
index 4624379..3c90544 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1172,7 +1172,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
CHECK_CHARACTER (TOP);
int c = XFIXNAT (TOP);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
}
NEXT;
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 5018b7b..9a711a8 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -220,6 +220,13 @@ case_character (struct casing_str_buf *buf, struct
casing_context *ctx,
return changed;
}
+/* If C is not ASCII, make it unibyte. */
+static int
+make_char_unibyte (int c)
+{
+ return ASCII_CHAR_P (c) ? c : CHAR_TO_BYTE8 (c);
+}
+
static Lisp_Object
do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
{
@@ -243,13 +250,13 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object
obj)
|| !NILP (BVAR (current_buffer,
enable_multibyte_characters)));
if (! multibyte)
- MAKE_CHAR_MULTIBYTE (ch);
+ ch = make_char_multibyte (ch);
int cased = case_single_character (ctx, ch);
if (cased == ch)
return obj;
if (! multibyte)
- MAKE_CHAR_UNIBYTE (cased);
+ cased = make_char_unibyte (cased);
return make_fixed_natnum (cased | flags);
}
@@ -278,7 +285,7 @@ do_casify_multibyte_string (struct casing_context *ctx,
Lisp_Object obj)
{
if (dst_end - o < sizeof (struct casing_str_buf))
string_overflow ();
- int ch = STRING_CHAR_ADVANCE (src);
+ int ch = string_char_advance (&src);
case_character ((struct casing_str_buf *) o, ctx, ch,
size > 1 ? src : NULL);
n += ((struct casing_str_buf *) o)->len_chars;
@@ -299,15 +306,14 @@ do_casify_unibyte_string (struct casing_context *ctx,
Lisp_Object obj)
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
- ch = SREF (obj, i);
- MAKE_CHAR_MULTIBYTE (ch);
+ ch = make_char_multibyte (SREF (obj, i));
cased = case_single_character (ctx, ch);
if (ch == cased)
continue;
- MAKE_CHAR_UNIBYTE (cased);
+ cased = make_char_unibyte (cased);
/* If the char can't be converted to a valid byte, just don't
change it. */
- if (cased >= 0 && cased < 256)
+ if (SINGLE_BYTE_CHAR_P (cased))
SSET (obj, i, cased);
}
return obj;
@@ -397,9 +403,7 @@ do_casify_unibyte_region (struct casing_context *ctx,
for (ptrdiff_t pos = *startp; pos < end; ++pos)
{
- int ch = FETCH_BYTE (pos);
- MAKE_CHAR_MULTIBYTE (ch);
-
+ int ch = make_char_multibyte (FETCH_BYTE (pos));
int cased = case_single_character (ctx, ch);
if (cased == ch)
continue;
@@ -408,8 +412,7 @@ do_casify_unibyte_region (struct casing_context *ctx,
if (first < 0)
first = pos;
- MAKE_CHAR_UNIBYTE (cased);
- FETCH_BYTE (pos) = cased;
+ FETCH_BYTE (pos) = make_char_unibyte (cased);
}
*startp = first;
@@ -433,8 +436,7 @@ do_casify_multibyte_region (struct casing_context *ctx,
for (; size; --size)
{
- int len;
- int ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (pos_byte), len);
+ int len, ch = string_char_and_length (BYTE_POS_ADDR (pos_byte), &len);
struct casing_str_buf buf;
if (!case_character (&buf, ctx, ch,
size > 1 ? BYTE_POS_ADDR (pos_byte + len) : NULL))
diff --git a/src/ccl.c b/src/ccl.c
index ac44dc1..0f82b97 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -855,6 +855,13 @@ struct ccl_prog_stack
/* For the moment, we only support depth 256 of stack. */
static struct ccl_prog_stack ccl_prog_stack_struct[256];
+/* Return a translation table of id number ID. */
+static Lisp_Object
+GET_TRANSLATION_TABLE (int id)
+{
+ return XCDR (XVECTOR (Vtranslation_table_vector)->contents[id]);
+}
+
void
ccl_driver (struct ccl_program *ccl, int *source, int *destination, int
src_size, int dst_size, Lisp_Object charset_list)
{
@@ -2101,7 +2108,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING
&optional CONTINUE UNIBY
source[j++] = *p++;
else
while (j < CCL_EXECUTE_BUF_SIZE && p < endp)
- source[j++] = STRING_CHAR_ADVANCE (p);
+ source[j++] = string_char_advance (&p);
consumed_chars += j;
consumed_bytes = p - SDATA (str);
@@ -2126,7 +2133,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING
&optional CONTINUE UNIBY
if (NILP (unibyte_p))
{
for (j = 0; j < ccl.produced; j++)
- CHAR_STRING_ADVANCE (destination[j], outp);
+ outp += CHAR_STRING (destination[j], outp);
}
else
{
diff --git a/src/character.c b/src/character.c
index c938e9f..edcec5f 100644
--- a/src/character.c
+++ b/src/character.c
@@ -141,15 +141,11 @@ char_string (unsigned int c, unsigned char *p)
}
-/* Return a character whose multibyte form is at P. If LEN is not
- NULL, it must be a pointer to integer. In that case, set *LEN to
- the byte length of the multibyte form. If ADVANCED is not NULL, it
- must be a pointer to unsigned char. In that case, set *ADVANCED to
- the ending address (i.e., the starting address of the next
- character) of the multibyte form. */
+/* Return a character whose multibyte form is at P. Set *LEN to the
+ byte length of the multibyte form. */
int
-string_char (const unsigned char *p, const unsigned char **advanced, int *len)
+string_char (const unsigned char *p, int *len)
{
int c;
const unsigned char *saved_p = p;
@@ -157,7 +153,7 @@ string_char (const unsigned char *p, const unsigned char
**advanced, int *len)
if (*p < 0x80 || ! (*p & 0x20) || ! (*p & 0x10))
{
/* 1-, 2-, and 3-byte sequences can be handled by the macro. */
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
}
else if (! (*p & 0x08))
{
@@ -185,10 +181,7 @@ string_char (const unsigned char *p, const unsigned char
**advanced, int *len)
p += 5;
}
- if (len)
- *len = p - saved_p;
- if (advanced)
- *advanced = p;
+ *len = p - saved_p;
return c;
}
@@ -248,8 +241,7 @@ DEFUN ("unibyte-char-to-multibyte",
Funibyte_char_to_multibyte,
c = XFIXNAT (ch);
if (c >= 0x100)
error ("Not a unibyte character: %d", c);
- MAKE_CHAR_MULTIBYTE (c);
- return make_fixnum (c);
+ return make_fixnum (make_char_multibyte (c));
}
DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
@@ -340,8 +332,7 @@ c_string_width (const unsigned char *str, ptrdiff_t len,
int precision,
while (i_byte < len)
{
- int bytes;
- int c = STRING_CHAR_AND_LENGTH (str + i_byte, bytes);
+ int bytes, c = string_char_and_length (str + i_byte, &bytes);
ptrdiff_t thiswidth = char_width (c, dp);
if (0 < precision && precision - width < thiswidth)
@@ -418,7 +409,7 @@ lisp_string_width (Lisp_Object string, ptrdiff_t precision,
if (multibyte)
{
int cbytes;
- c = STRING_CHAR_AND_LENGTH (str + i_byte, cbytes);
+ c = string_char_and_length (str + i_byte, &cbytes);
bytes = cbytes;
}
else
@@ -495,7 +486,7 @@ multibyte_chars_in_text (const unsigned char *ptr,
ptrdiff_t nbytes)
while (ptr < endp)
{
- int len = MULTIBYTE_LENGTH (ptr, endp);
+ int len = multibyte_length (ptr, endp, true, true);
if (len == 0)
emacs_abort ();
@@ -517,16 +508,15 @@ parse_str_as_multibyte (const unsigned char *str,
ptrdiff_t len,
ptrdiff_t *nchars, ptrdiff_t *nbytes)
{
const unsigned char *endp = str + len;
- int n;
ptrdiff_t chars = 0, bytes = 0;
if (len >= MAX_MULTIBYTE_LENGTH)
{
- const unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ const unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
while (str < adjusted_endp)
{
- if (! CHAR_BYTE8_HEAD_P (*str)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (str)) > 0)
+ int n = multibyte_length (str, NULL, false, false);
+ if (0 < n)
str += n, bytes += n;
else
str++, bytes += 2;
@@ -535,8 +525,8 @@ parse_str_as_multibyte (const unsigned char *str, ptrdiff_t
len,
}
while (str < endp)
{
- if (! CHAR_BYTE8_HEAD_P (*str)
- && (n = MULTIBYTE_LENGTH (str, endp)) > 0)
+ int n = multibyte_length (str, endp, true, false);
+ if (0 < n)
str += n, bytes += n;
else
str++, bytes += 2;
@@ -563,20 +553,25 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len,
ptrdiff_t nbytes,
unsigned char *p = str, *endp = str + nbytes;
unsigned char *to;
ptrdiff_t chars = 0;
- int n;
if (nbytes >= MAX_MULTIBYTE_LENGTH)
{
- unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
- while (p < adjusted_endp
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
- p += n, chars++;
+ unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
+ while (p < adjusted_endp)
+ {
+ int n = multibyte_length (p, NULL, false, false);
+ if (n <= 0)
+ break;
+ p += n, chars++;
+ }
+ }
+ while (true)
+ {
+ int n = multibyte_length (p, endp, true, false);
+ if (n <= 0)
+ break;
+ p += n, chars++;
}
- while (p < endp
- && ! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
- p += n, chars++;
if (nchars)
*nchars = chars;
if (p == endp)
@@ -590,11 +585,11 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len,
ptrdiff_t nbytes,
if (nbytes >= MAX_MULTIBYTE_LENGTH)
{
- unsigned char *adjusted_endp = endp - MAX_MULTIBYTE_LENGTH;
+ unsigned char *adjusted_endp = endp - (MAX_MULTIBYTE_LENGTH - 1);
while (p < adjusted_endp)
{
- if (! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH_NO_CHECK (p)) > 0)
+ int n = multibyte_length (p, NULL, false, false);
+ if (0 < n)
{
while (n--)
*to++ = *p++;
@@ -610,8 +605,8 @@ str_as_multibyte (unsigned char *str, ptrdiff_t len,
ptrdiff_t nbytes,
}
while (p < endp)
{
- if (! CHAR_BYTE8_HEAD_P (*p)
- && (n = MULTIBYTE_LENGTH (p, endp)) > 0)
+ int n = multibyte_length (p, endp, true, false);
+ if (0 < n)
{
while (n--)
*to++ = *p++;
@@ -706,7 +701,7 @@ str_as_unibyte (unsigned char *str, ptrdiff_t bytes)
len = BYTES_BY_CHAR_HEAD (c);
if (CHAR_BYTE8_HEAD_P (c))
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
*to++ = CHAR_TO_BYTE8 (c);
}
else
@@ -730,7 +725,7 @@ str_to_unibyte (const unsigned char *src, unsigned char
*dst, ptrdiff_t chars)
for (i = 0; i < chars; i++)
{
- int c = STRING_CHAR_ADVANCE (src);
+ int c = string_char_advance (&src);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
@@ -823,7 +818,7 @@ string_escape_byte8 (Lisp_Object string)
if (CHAR_BYTE8_HEAD_P (c))
{
- c = STRING_CHAR_ADVANCE (src);
+ c = string_char_advance (&src);
c = CHAR_TO_BYTE8 (c);
dst += sprintf ((char *) dst, "\\%03o", c + 0u);
}
diff --git a/src/character.h b/src/character.h
index 7639b01..4887473 100644
--- a/src/character.h
+++ b/src/character.h
@@ -31,35 +31,39 @@ INLINE_HEADER_BEGIN
/* character code 1st byte byte sequence
-------------- -------- -------------
0-7F 00..7F 0xxxxxxx
- 80-7FF C2..DF 110xxxxx 10xxxxxx
- 800-FFFF E0..EF 1110xxxx 10xxxxxx 10xxxxxx
- 10000-1FFFFF F0..F7 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
- 200000-3FFF7F F8 11111000 1000xxxx 10xxxxxx 10xxxxxx 10xxxxxx
+ 80-7FF C2..DF 110yyyyx 10xxxxxx
+ 800-FFFF E0..EF 1110yyyy 10yxxxxx 10xxxxxx
+ 10000-1FFFFF F0..F7 11110yyy 10yyxxxx 10xxxxxx 10xxxxxx
+ 200000-3FFF7F F8 11111000 1000yxxx 10xxxxxx 10xxxxxx 10xxxxxx
3FFF80-3FFFFF C0..C1 1100000x 10xxxxxx (for eight-bit-char)
400000-... invalid
invalid 1st byte 80..BF 10xxxxxx
- F9..FF 11111xxx (xxx != 000)
+ F9..FF 11111yyy
+
+ In each bit pattern, 'x' and 'y' each represent a single bit of the
+ character code payload, and least one 'y' must be a 1 bit.
+ In the 5-byte sequence, the 22-bit payload cannot exceed 3FFF7F.
*/
/* Maximum character code ((1 << CHARACTERBITS) - 1). */
-#define MAX_CHAR 0x3FFFFF
+enum { MAX_CHAR = 0x3FFFFF };
/* Maximum Unicode character code. */
-#define MAX_UNICODE_CHAR 0x10FFFF
+enum { MAX_UNICODE_CHAR = 0x10FFFF };
/* Maximum N-byte character codes. */
-#define MAX_1_BYTE_CHAR 0x7F
-#define MAX_2_BYTE_CHAR 0x7FF
-#define MAX_3_BYTE_CHAR 0xFFFF
-#define MAX_4_BYTE_CHAR 0x1FFFFF
-#define MAX_5_BYTE_CHAR 0x3FFF7F
+enum { MAX_1_BYTE_CHAR = 0x7F };
+enum { MAX_2_BYTE_CHAR = 0x7FF };
+enum { MAX_3_BYTE_CHAR = 0xFFFF };
+enum { MAX_4_BYTE_CHAR = 0x1FFFFF };
+enum { MAX_5_BYTE_CHAR = 0x3FFF7F };
/* Minimum leading code of multibyte characters. */
-#define MIN_MULTIBYTE_LEADING_CODE 0xC0
+enum { MIN_MULTIBYTE_LEADING_CODE = 0xC0 };
/* Maximum leading code of multibyte characters. Note: this must be
updated if we ever increase MAX_CHAR above. */
-#define MAX_MULTIBYTE_LEADING_CODE 0xF8
+enum { MAX_MULTIBYTE_LEADING_CODE = 0xF8 };
/* Unicode character values. */
enum
@@ -81,51 +85,74 @@ enum
};
extern int char_string (unsigned, unsigned char *);
+extern int string_char (const unsigned char *, int *);
/* UTF-8 encodings. Use \x escapes, so they are portable to pre-C11
compilers and can be concatenated with ordinary string literals. */
#define uLSQM "\xE2\x80\x98" /* U+2018 LEFT SINGLE QUOTATION MARK */
#define uRSQM "\xE2\x80\x99" /* U+2019 RIGHT SINGLE QUOTATION MARK */
-/* Nonzero iff C is a character that corresponds to a raw 8-bit
+/* True iff C is a character of code less than 0x100. */
+INLINE bool
+SINGLE_BYTE_CHAR_P (intmax_t c)
+{
+ return 0 <= c && c < 0x100;
+}
+
+/* True iff C is a character that corresponds to a raw 8-bit
byte. */
-#define CHAR_BYTE8_P(c) ((c) > MAX_5_BYTE_CHAR)
+INLINE bool
+CHAR_BYTE8_P (int c)
+{
+ return MAX_5_BYTE_CHAR < c;
+}
/* Return the character code for raw 8-bit byte BYTE. */
-#define BYTE8_TO_CHAR(byte) ((byte) + 0x3FFF00)
+INLINE int
+BYTE8_TO_CHAR (int byte)
+{
+ return byte + 0x3FFF00;
+}
-#define UNIBYTE_TO_CHAR(byte) \
- (ASCII_CHAR_P (byte) ? (byte) : BYTE8_TO_CHAR (byte))
+INLINE int
+UNIBYTE_TO_CHAR (int byte)
+{
+ return ASCII_CHAR_P (byte) ? byte : BYTE8_TO_CHAR (byte);
+}
/* Return the raw 8-bit byte for character C. */
-#define CHAR_TO_BYTE8(c) (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : (c & 0xFF))
+INLINE int
+CHAR_TO_BYTE8 (int c)
+{
+ return CHAR_BYTE8_P (c) ? c - 0x3FFF00 : c & 0xFF;
+}
/* Return the raw 8-bit byte for character C,
or -1 if C doesn't correspond to a byte. */
-#define CHAR_TO_BYTE_SAFE(c) \
- (ASCII_CHAR_P (c) ? c : (CHAR_BYTE8_P (c) ? (c) - 0x3FFF00 : -1))
+INLINE int
+CHAR_TO_BYTE_SAFE (int c)
+{
+ return ASCII_CHAR_P (c) ? c : CHAR_BYTE8_P (c) ? c - 0x3FFF00 : -1;
+}
-/* Nonzero iff BYTE is the 1st byte of a multibyte form of a character
+/* True iff BYTE is the 1st byte of a multibyte form of a character
that corresponds to a raw 8-bit byte. */
-#define CHAR_BYTE8_HEAD_P(byte) ((byte) == 0xC0 || (byte) == 0xC1)
-
-/* If C is not ASCII, make it unibyte. */
-#define MAKE_CHAR_UNIBYTE(c) \
- do { \
- if (! ASCII_CHAR_P (c)) \
- c = CHAR_TO_BYTE8 (c); \
- } while (false)
-
+INLINE bool
+CHAR_BYTE8_HEAD_P (int byte)
+{
+ return byte == 0xC0 || byte == 0xC1;
+}
/* If C is not ASCII, make it multibyte. Assumes C < 256. */
-#define MAKE_CHAR_MULTIBYTE(c) \
- (eassert ((c) >= 0 && (c) < 256), (c) = UNIBYTE_TO_CHAR (c))
+INLINE int
+make_char_multibyte (int c)
+{
+ eassert (SINGLE_BYTE_CHAR_P (c));
+ return UNIBYTE_TO_CHAR (c);
+}
/* This is the maximum byte length of multibyte form. */
-#define MAX_MULTIBYTE_LENGTH 5
-
-/* Nonzero iff X is a character. */
-#define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR)
+enum { MAX_MULTIBYTE_LENGTH = 5 };
/* Nonzero iff C is valid as a character code. */
INLINE bool
@@ -134,52 +161,62 @@ CHAR_VALID_P (intmax_t c)
return 0 <= c && c <= MAX_CHAR;
}
-/* Check if Lisp object X is a character or not. */
-#define CHECK_CHARACTER(x) \
- CHECK_TYPE (CHARACTERP (x), Qcharacterp, x)
-
-#define CHECK_CHARACTER_CAR(x) \
- do { \
- Lisp_Object tmp = XCAR (x); \
- CHECK_CHARACTER (tmp); \
- } while (false)
-
-#define CHECK_CHARACTER_CDR(x) \
- do { \
- Lisp_Object tmp = XCDR (x); \
- CHECK_CHARACTER (tmp); \
- } while (false)
-
-/* Nonzero iff C is a character of code less than 0x100. */
+/* Nonzero iff X is a character. */
INLINE bool
-SINGLE_BYTE_CHAR_P (intmax_t c)
+CHARACTERP (Lisp_Object x)
{
- return 0 <= c && c < 0x100;
+ return FIXNUMP (x) && CHAR_VALID_P (XFIXNUM (x));
}
-/* Nonzero if character C has a printable glyph. */
-#define CHAR_PRINTABLE_P(c) \
- (((c) >= 32 && (c) < 127) \
- || ! NILP (CHAR_TABLE_REF (Vprintable_chars, (c))))
+/* Check if Lisp object X is a character or not. */
+INLINE void
+CHECK_CHARACTER (Lisp_Object x)
+{
+ CHECK_TYPE (CHARACTERP (x), Qcharacterp, x);
+}
-/* Return byte length of multibyte form for character C. */
-#define CHAR_BYTES(c) \
- ( (c) <= MAX_1_BYTE_CHAR ? 1 \
- : (c) <= MAX_2_BYTE_CHAR ? 2 \
- : (c) <= MAX_3_BYTE_CHAR ? 3 \
- : (c) <= MAX_4_BYTE_CHAR ? 4 \
- : (c) <= MAX_5_BYTE_CHAR ? 5 \
- : 2)
+INLINE void
+CHECK_CHARACTER_CAR (Lisp_Object x)
+{
+ CHECK_CHARACTER (XCAR (x));
+}
+
+INLINE void
+CHECK_CHARACTER_CDR (Lisp_Object x)
+{
+ CHECK_CHARACTER (XCDR (x));
+}
+
+/* True if character C has a printable glyph. */
+INLINE bool
+CHAR_PRINTABLE_P (int c)
+{
+ return ((32 <= c && c < 127)
+ || ! NILP (CHAR_TABLE_REF (Vprintable_chars, c)));
+}
+/* Return byte length of multibyte form for character C. */
+INLINE int
+CHAR_BYTES (int c)
+{
+ return ((MAX_5_BYTE_CHAR < c ? -2 : 1)
+ + (MAX_1_BYTE_CHAR < c)
+ + (MAX_2_BYTE_CHAR < c)
+ + (MAX_3_BYTE_CHAR < c)
+ + (MAX_4_BYTE_CHAR < c));
+}
/* Return the leading code of multibyte form of C. */
-#define CHAR_LEADING_CODE(c) \
- ((c) <= MAX_1_BYTE_CHAR ? c \
- : (c) <= MAX_2_BYTE_CHAR ? (0xC0 | ((c) >> 6)) \
- : (c) <= MAX_3_BYTE_CHAR ? (0xE0 | ((c) >> 12)) \
- : (c) <= MAX_4_BYTE_CHAR ? (0xF0 | ((c) >> 18)) \
- : (c) <= MAX_5_BYTE_CHAR ? 0xF8 \
- : (0xC0 | (((c) >> 6) & 0x01)))
+INLINE int
+CHAR_LEADING_CODE (int c)
+{
+ return (c <= MAX_1_BYTE_CHAR ? c
+ : c <= MAX_2_BYTE_CHAR ? 0xC0 | (c >> 6)
+ : c <= MAX_3_BYTE_CHAR ? 0xE0 | (c >> 12)
+ : c <= MAX_4_BYTE_CHAR ? 0xF0 | (c >> 18)
+ : c <= MAX_5_BYTE_CHAR ? 0xF8
+ : 0xC0 | ((c >> 6) & 0x01));
+}
/* Store multibyte form of the character C in P. The caller should
@@ -217,418 +254,255 @@ CHAR_STRING (int c, unsigned char *p)
least MAX_MULTIBYTE_LENGTH bytes area at P in advance. Returns the
length of the multibyte form. */
-#define BYTE8_STRING(b, p) \
- ((p)[0] = (0xC0 | (((b) >> 6) & 0x01)), \
- (p)[1] = (0x80 | ((b) & 0x3F)), \
- 2)
-
-
-/* Store multibyte form of the character C in P and advance P to the
- end of the multibyte form. The caller should allocate at least
- MAX_MULTIBYTE_LENGTH bytes area at P in advance. */
-
-#define CHAR_STRING_ADVANCE(c, p) \
- do { \
- if ((c) <= MAX_1_BYTE_CHAR) \
- *(p)++ = (c); \
- else if ((c) <= MAX_2_BYTE_CHAR) \
- *(p)++ = (0xC0 | ((c) >> 6)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else if ((c) <= MAX_3_BYTE_CHAR) \
- *(p)++ = (0xE0 | ((c) >> 12)), \
- *(p)++ = (0x80 | (((c) >> 6) & 0x3F)), \
- *(p)++ = (0x80 | ((c) & 0x3F)); \
- else \
- { \
- verify (sizeof (c) <= sizeof (unsigned)); \
- (p) += char_string (c, p); \
- } \
- } while (false)
-
-
-/* Nonzero iff BYTE starts a non-ASCII character in a multibyte
- form. */
-#define LEADING_CODE_P(byte) (((byte) & 0xC0) == 0xC0)
-
-/* Nonzero iff BYTE is a trailing code of a non-ASCII character in a
+INLINE int
+BYTE8_STRING (int b, unsigned char *p)
+{
+ p[0] = 0xC0 | ((b >> 6) & 0x01);
+ p[1] = 0x80 | (b & 0x3F);
+ return 2;
+}
+
+
+/* True iff BYTE starts a non-ASCII character in a multibyte form. */
+INLINE bool
+LEADING_CODE_P (int byte)
+{
+ return (byte & 0xC0) == 0xC0;
+}
+
+/* True iff BYTE is a trailing code of a non-ASCII character in a
multibyte form. */
-#define TRAILING_CODE_P(byte) (((byte) & 0xC0) == 0x80)
+INLINE bool
+TRAILING_CODE_P (int byte)
+{
+ return (byte & 0xC0) == 0x80;
+}
-/* Nonzero iff BYTE starts a character in a multibyte form.
+/* True iff BYTE starts a character in a multibyte form.
This is equivalent to:
(ASCII_CHAR_P (byte) || LEADING_CODE_P (byte)) */
-#define CHAR_HEAD_P(byte) (((byte) & 0xC0) != 0x80)
+INLINE bool
+CHAR_HEAD_P (int byte)
+{
+ return (byte & 0xC0) != 0x80;
+}
/* How many bytes a character that starts with BYTE occupies in a
- multibyte form. Unlike MULTIBYTE_LENGTH below, this macro does not
+ multibyte form. Unlike multibyte_length, this function does not
validate the multibyte form, but looks only at its first byte. */
-#define BYTES_BY_CHAR_HEAD(byte) \
- (!((byte) & 0x80) ? 1 \
- : !((byte) & 0x20) ? 2 \
- : !((byte) & 0x10) ? 3 \
- : !((byte) & 0x08) ? 4 \
- : 5)
+INLINE int
+BYTES_BY_CHAR_HEAD (int byte)
+{
+ return (!(byte & 0x80) ? 1
+ : !(byte & 0x20) ? 2
+ : !(byte & 0x10) ? 3
+ : !(byte & 0x08) ? 4
+ : 5);
+}
-/* The byte length of multibyte form at unibyte string P ending at
- PEND. If the string doesn't point to a valid multibyte form,
- return 0. Unlike BYTES_BY_CHAR_HEAD, this macro validates the
- multibyte form. */
+/* The byte length of the multibyte form at the unibyte string P,
+ ending at PEND if CHECK, and without a length check if !CHECK.
+ If ALLOW_8BIT, allow multibyte forms of eight-bit characters.
+ If the string doesn't point to a valid multibyte form, return 0.
+ Unlike BYTES_BY_CHAR_HEAD, this function validates the multibyte form. */
-#define MULTIBYTE_LENGTH(p, pend) \
- (p >= pend ? 0 \
- : !((p)[0] & 0x80) ? 1 \
- : ((p + 1 >= pend) || (((p)[1] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xE0) == 0xC0 ? 2 \
- : ((p + 2 >= pend) || (((p)[2] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xF0) == 0xE0 ? 3 \
- : ((p + 3 >= pend) || (((p)[3] & 0xC0) != 0x80)) ? 0 \
- : ((p)[0] & 0xF8) == 0xF0 ? 4 \
- : ((p + 4 >= pend) || (((p)[4] & 0xC0) != 0x80)) ? 0 \
- : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
- : 0)
-
-
-/* Like MULTIBYTE_LENGTH, but don't check the ending address. The
- multibyte form is still validated, unlike BYTES_BY_CHAR_HEAD. */
-
-#define MULTIBYTE_LENGTH_NO_CHECK(p) \
- (!((p)[0] & 0x80) ? 1 \
- : ((p)[1] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xE0) == 0xC0 ? 2 \
- : ((p)[2] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xF0) == 0xE0 ? 3 \
- : ((p)[3] & 0xC0) != 0x80 ? 0 \
- : ((p)[0] & 0xF8) == 0xF0 ? 4 \
- : ((p)[4] & 0xC0) != 0x80 ? 0 \
- : (p)[0] == 0xF8 && ((p)[1] & 0xF0) == 0x80 ? 5 \
- : 0)
-
-/* If P is before LIMIT, advance P to the next character boundary.
- Assumes that P is already at a character boundary of the same
- multibyte form whose end address is LIMIT. */
+INLINE int
+multibyte_length (unsigned char const *p, unsigned char const *pend,
+ bool check, bool allow_8bit)
+{
+ if (!check || p < pend)
+ {
+ unsigned char c = p[0];
+ if (c < 0x80)
+ return 1;
+ if (!check || p + 1 < pend)
+ {
+ /* The 'unsigned int' avoids int overflow in the 5-byte case. */
+ unsigned int d = p[1];
+
+ if (TRAILING_CODE_P (d))
+ {
+ if (allow_8bit ? (c & 0xE0) == 0xC0 : 0xC2 <= c && c <= 0xDF)
+ return 2;
+ if ((!check || p + 2 < pend)
+ && TRAILING_CODE_P (p[2]))
+ {
+ if ((c & 0xF0) == 0xE0 && ((c & 0x0F) | (d & 0x20)))
+ return 3;
+ if ((!check || p + 3 < pend) && TRAILING_CODE_P (p[3]))
+ {
+ if ((c & 0xF8) == 0xF0 && ((c & 0x07) | (d & 0x30)))
+ return 4;
+ if (c == 0xF8 && (!check || p + 4 < pend)
+ && TRAILING_CODE_P (p[4]))
+ {
+ unsigned int w = ((d << 24) + (p[2] << 16)
+ + (p[3] << 8) + p[4]);
+ if (0x88808080 <= w && w <= 0x8FBFBDBF)
+ return 5;
+ }
+ }
+ }
+ }
+ }
+ }
-#define NEXT_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) < (limit)) \
- (p) += BYTES_BY_CHAR_HEAD (*(p)); \
- } while (false)
+ return 0;
+}
-/* If P is after LIMIT, advance P to the previous character boundary.
+/* Return number of bytes in the multibyte character just before P.
Assumes that P is already at a character boundary of the same
- multibyte form whose beginning address is LIMIT. */
-
-#define PREV_CHAR_BOUNDARY(p, limit) \
- do { \
- if ((p) > (limit)) \
- {
\
- const unsigned char *chp = (p); \
- do { \
- chp--; \
- } while (chp >= limit && ! CHAR_HEAD_P (*chp)); \
- (p) = (BYTES_BY_CHAR_HEAD (*chp) == (p) - chp) ? chp : (p) - 1; \
- }
\
- } while (false)
+ multibyte form, and is not at the start of that form. */
+
+INLINE int
+raw_prev_char_len (unsigned char const *p)
+{
+ for (int len = 1; ; len++)
+ if (CHAR_HEAD_P (p[-len]))
+ return len;
+}
+
+
+/* Return the character code of character whose multibyte form is at P,
+ and set *LENGTH to its length. */
+
+INLINE int
+string_char_and_length (unsigned char const *p, int *length)
+{
+ int c, len;
+
+ if (! (p[0] & 0x80))
+ {
+ len = 1;
+ c = p[0];
+ }
+ else if (! (p[0] & 0x20))
+ {
+ len = 2;
+ c = ((((p[0] & 0x1F) << 6)
+ | (p[1] & 0x3F))
+ + (p[0] < 0xC2 ? 0x3FFF80 : 0));
+ }
+ else if (! (p[0] & 0x10))
+ {
+ len = 3;
+ c = (((p[0] & 0x0F) << 12)
+ | ((p[1] & 0x3F) << 6)
+ | (p[2] & 0x3F));
+ }
+ else
+ c = string_char (p, &len);
+
+ eassume (0 < len && len <= MAX_MULTIBYTE_LENGTH);
+ *length = len;
+ return c;
+}
/* Return the character code of character whose multibyte form is at P. */
-#define STRING_CHAR(p) \
- (!((p)[0] & 0x80) \
- ? (p)[0] \
- : ! ((p)[0] & 0x20) \
- ? (((((p)[0] & 0x1F) << 6) \
- | ((p)[1] & 0x3F)) \
- + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0)) \
- : ! ((p)[0] & 0x10) \
- ? ((((p)[0] & 0x0F) << 12) \
- | (((p)[1] & 0x3F) << 6) \
- | ((p)[2] & 0x3F)) \
- : string_char ((p), NULL, NULL))
-
-
-/* Like STRING_CHAR, but set ACTUAL_LEN to the length of multibyte
- form. */
-
-#define STRING_CHAR_AND_LENGTH(p, actual_len) \
- (!((p)[0] & 0x80) \
- ? ((actual_len) = 1, (p)[0]) \
- : ! ((p)[0] & 0x20) \
- ? ((actual_len) = 2, \
- (((((p)[0] & 0x1F) << 6) \
- | ((p)[1] & 0x3F)) \
- + (((unsigned char) (p)[0]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((actual_len) = 3, \
- ((((p)[0] & 0x0F) << 12) \
- | (((p)[1] & 0x3F) << 6) \
- | ((p)[2] & 0x3F))) \
- : string_char ((p), NULL, &actual_len))
-
-
-/* Like STRING_CHAR, but advance P to the end of multibyte form. */
-
-#define STRING_CHAR_ADVANCE(p) \
- (!((p)[0] & 0x80) \
- ? *(p)++ \
- : ! ((p)[0] & 0x20) \
- ? ((p) += 2, \
- ((((p)[-2] & 0x1F) << 6) \
- | ((p)[-1] & 0x3F) \
- | ((unsigned char) ((p)[-2]) < 0xC2 ? 0x3FFF80 : 0))) \
- : ! ((p)[0] & 0x10) \
- ? ((p) += 3, \
- ((((p)[-3] & 0x0F) << 12) \
- | (((p)[-2] & 0x3F) << 6) \
- | ((p)[-1] & 0x3F))) \
- : string_char ((p), &(p), NULL))
-
-
-/* Fetch the "next" character from Lisp string STRING at byte position
- BYTEIDX, character position CHARIDX. Store it into OUTPUT.
-
- All the args must be side-effect-free.
- BYTEIDX and CHARIDX must be lvalues;
- we increment them past the character fetched. */
-
-#define FETCH_STRING_CHAR_ADVANCE(OUTPUT, STRING, CHARIDX, BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (STRING_MULTIBYTE (STRING)) \
- { \
- unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = SREF (STRING, BYTEIDX); \
- BYTEIDX++; \
- } \
- } \
- while (false)
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but return a multibyte character
- even if STRING is unibyte. */
+INLINE int
+STRING_CHAR (unsigned char const *p)
+{
+ int len;
+ return string_char_and_length (p, &len);
+}
-#define FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE(OUTPUT, STRING, CHARIDX,
BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (STRING_MULTIBYTE (STRING)) \
- { \
- unsigned char *chp = &SDATA (STRING)[BYTEIDX]; \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = SREF (STRING, BYTEIDX); \
- BYTEIDX++; \
- MAKE_CHAR_MULTIBYTE (OUTPUT); \
- } \
- } \
- while (false)
-
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but assumes STRING is multibyte. */
-
-#define FETCH_STRING_CHAR_ADVANCE_NO_CHECK(OUTPUT, STRING, CHARIDX, BYTEIDX) \
- do \
- { \
- unsigned char *fetch_ptr = &SDATA (STRING)[BYTEIDX]; \
- int fetch_len; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (fetch_ptr, fetch_len); \
- BYTEIDX += fetch_len; \
- CHARIDX++; \
- } \
- while (false)
-
-
-/* Like FETCH_STRING_CHAR_ADVANCE, but fetch character from the current
- buffer. */
-
-#define FETCH_CHAR_ADVANCE(OUTPUT, CHARIDX, BYTEIDX) \
- do \
- { \
- CHARIDX++; \
- if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- { \
- unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- } \
- else \
- { \
- OUTPUT = *(BYTE_POS_ADDR (BYTEIDX)); \
- BYTEIDX++; \
- } \
- } \
- while (false)
-
-
-/* Like FETCH_CHAR_ADVANCE, but assumes the current buffer is multibyte. */
-
-#define FETCH_CHAR_ADVANCE_NO_CHECK(OUTPUT, CHARIDX, BYTEIDX) \
- do \
- { \
- unsigned char *chp = BYTE_POS_ADDR (BYTEIDX); \
- int chlen; \
- \
- OUTPUT = STRING_CHAR_AND_LENGTH (chp, chlen); \
- BYTEIDX += chlen; \
- CHARIDX++; \
- } \
- while (false)
-
-
-/* Increment the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. No range checking of POS. */
-
-#define INC_POS(pos_byte) \
- do { \
- unsigned char *chp = BYTE_POS_ADDR (pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*chp); \
- } while (false)
-
-
-/* Decrement the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS. */
-
-#define DEC_POS(pos_byte) \
- do { \
- unsigned char *chp; \
- \
- pos_byte--; \
- if (pos_byte < GPT_BYTE) \
- chp = BEG_ADDR + pos_byte - BEG_BYTE; \
- else \
- chp = BEG_ADDR + GAP_SIZE + pos_byte - BEG_BYTE; \
- while (!CHAR_HEAD_P (*chp)) \
- { \
- chp--; \
- pos_byte--; \
- } \
- } while (false)
-
-/* Increment both CHARPOS and BYTEPOS, each in the appropriate way. */
-
-#define INC_BOTH(charpos, bytepos) \
- do \
- { \
- (charpos)++; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- (bytepos)++; \
- else \
- INC_POS ((bytepos)); \
- } \
- while (false)
-
-
-/* Decrement both CHARPOS and BYTEPOS, each in the appropriate way. */
-
-#define DEC_BOTH(charpos, bytepos) \
- do \
- { \
- (charpos)--; \
- if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \
- (bytepos)--; \
- else \
- DEC_POS ((bytepos)); \
- } \
- while (false)
-
-
-/* Increment the buffer byte position POS_BYTE of the current buffer to
- the next character boundary. This macro relies on the fact that
- *GPT_ADDR and *Z_ADDR are always accessible and the values are
- '\0'. No range checking of POS_BYTE. */
-
-#define BUF_INC_POS(buf, pos_byte) \
- do { \
- unsigned char *chp = BUF_BYTE_ADDRESS (buf, pos_byte); \
- pos_byte += BYTES_BY_CHAR_HEAD (*chp); \
- } while (false)
-
-
-/* Decrement the buffer byte position POS_BYTE of the current buffer to
- the previous character boundary. No range checking of POS_BYTE. */
-
-#define BUF_DEC_POS(buf, pos_byte) \
- do { \
- unsigned char *chp;
\
- pos_byte--;
\
- if (pos_byte < BUF_GPT_BYTE (buf)) \
- chp = BUF_BEG_ADDR (buf) + pos_byte - BEG_BYTE; \
- else \
- chp = BUF_BEG_ADDR (buf) + BUF_GAP_SIZE (buf) + pos_byte - BEG_BYTE;\
- while (!CHAR_HEAD_P (*chp))
\
- {
\
- chp--; \
- pos_byte--; \
- }
\
- } while (false)
-
-
-/* Return a non-outlandish value for the tab width. */
-
-#define SANE_TAB_WIDTH(buf) sanitize_tab_width (BVAR (buf, tab_width))
+
+/* Like STRING_CHAR (*PP), but advance *PP to the end of multibyte form. */
INLINE int
-sanitize_tab_width (Lisp_Object width)
+string_char_advance (unsigned char const **pp)
{
- return (FIXNUMP (width) && 0 < XFIXNUM (width) && XFIXNUM (width) <= 1000
- ? XFIXNUM (width) : 8);
+ unsigned char const *p = *pp;
+ int len, c = string_char_and_length (p, &len);
+ *pp = p + len;
+ return c;
}
-/* Return the width of ASCII character C. The width is measured by
- how many columns C will occupy on the screen when displayed in the
- current buffer. */
-#define ASCII_CHAR_WIDTH(c) \
- (c < 0x20 \
- ? (c == '\t'
\
- ? SANE_TAB_WIDTH (current_buffer)
\
- : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2)))
\
- : (c < 0x7f \
- ? 1 \
- : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))))
+/* Return the next character from Lisp string STRING at byte position
+ *BYTEIDX, character position *CHARIDX. Update *BYTEIDX and
+ *CHARIDX past the character fetched. */
-/* Return a non-outlandish value for a character width. */
+INLINE int
+fetch_string_char_advance (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ int output;
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ if (STRING_MULTIBYTE (string))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = *chp;
+ b++;
+ }
+ (*charidx)++;
+ *byteidx = b;
+ return output;
+}
+
+/* Like fetch_string_char_advance, but return a multibyte character
+ even if STRING is unibyte. */
INLINE int
-sanitize_char_width (EMACS_INT width)
+fetch_string_char_as_multibyte_advance (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
{
- return 0 <= width && width <= 1000 ? width : 1000;
+ int output;
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ if (STRING_MULTIBYTE (string))
+ {
+ int chlen;
+ output = string_char_and_length (chp, &chlen);
+ b += chlen;
+ }
+ else
+ {
+ output = make_char_multibyte (*chp);
+ b++;
+ }
+ (*charidx)++;
+ *byteidx = b;
+ return output;
}
-/* Return the width of character C. The width is measured by how many
- columns C will occupy on the screen when displayed in the current
- buffer. The name CHARACTER_WIDTH avoids a collision with <limits.h>
- CHAR_WIDTH when enabled; see ISO/IEC TS 18661-1:2014. */
-#define CHARACTER_WIDTH(c) \
- (ASCII_CHAR_P (c) \
- ? ASCII_CHAR_WIDTH (c) \
- : sanitize_char_width (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
+/* Like fetch_string_char_advance, but assumes STRING is multibyte. */
+
+INLINE int
+fetch_string_char_advance_no_check (Lisp_Object string,
+ ptrdiff_t *charidx, ptrdiff_t *byteidx)
+{
+ ptrdiff_t b = *byteidx;
+ unsigned char *chp = SDATA (string) + b;
+ int chlen, output = string_char_and_length (chp, &chlen);
+ (*charidx)++;
+ *byteidx = b + chlen;
+ return output;
+}
+
/* If C is a variation selector, return the index of the
variation selector (1..256). Otherwise, return 0. */
-#define CHAR_VARIATION_SELECTOR_P(c) \
- ((c) < 0xFE00 ? 0 \
- : (c) <= 0xFE0F ? (c) - 0xFE00 + 1 \
- : (c) < 0xE0100 ? 0 \
- : (c) <= 0xE01EF ? (c) - 0xE0100 + 17 \
- : 0)
+INLINE int
+CHAR_VARIATION_SELECTOR_P (int c)
+{
+ return (c < 0xFE00 ? 0
+ : c <= 0xFE0F ? c - 0xFE00 + 1
+ : c < 0xE0100 ? 0
+ : c <= 0xE01EF ? c - 0xE0100 + 17
+ : 0);
+}
/* Return true if C is a surrogate. */
@@ -679,8 +553,6 @@ typedef enum {
} unicode_category_t;
extern EMACS_INT char_resolve_modifier_mask (EMACS_INT) ATTRIBUTE_CONST;
-extern int string_char (const unsigned char *,
- const unsigned char **, int *);
extern int translate_char (Lisp_Object, int c);
extern ptrdiff_t count_size_as_multibyte (const unsigned char *, ptrdiff_t);
@@ -705,10 +577,6 @@ extern bool graphicp (int);
extern bool printablep (int);
extern bool blankp (int);
-/* Return a translation table of id number ID. */
-#define GET_TRANSLATION_TABLE(id) \
- (XCDR (XVECTOR (Vtranslation_table_vector)->contents[(id)]))
-
/* Look up the element in char table OBJ at index CH, and return it as
an integer. If the element is not a character, return CH itself. */
diff --git a/src/charset.c b/src/charset.c
index 9e55d0c..8635aad 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1460,7 +1460,7 @@ string_xstring_p (Lisp_Object string)
while (p < endp)
{
- int c = STRING_CHAR_ADVANCE (p);
+ int c = string_char_advance (&p);
if (c >= 0x100)
return 2;
@@ -1504,7 +1504,7 @@ find_charsets_in_text (const unsigned char *ptr,
ptrdiff_t nchars,
{
while (ptr < pend)
{
- int c = STRING_CHAR_ADVANCE (ptr);
+ int c = string_char_advance (&ptr);
struct charset *charset;
if (!NILP (table))
diff --git a/src/chartab.c b/src/chartab.c
index 04205ac..cb2ced5 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -1117,10 +1117,10 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
{
/* SIMPLE TABLE */
p++;
- idx = STRING_CHAR_ADVANCE (p);
+ idx = string_char_advance (&p);
while (p < pend && idx < chartab_chars[2])
{
- int v = STRING_CHAR_ADVANCE (p);
+ int v = string_char_advance (&p);
set_sub_char_table_contents
(sub, idx++, v > 0 ? make_fixnum (v) : Qnil);
}
@@ -1131,13 +1131,13 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
p++;
for (idx = 0; p < pend; )
{
- int v = STRING_CHAR_ADVANCE (p);
+ int v = string_char_advance (&p);
int count = 1;
- int len;
if (p < pend)
{
- count = STRING_CHAR_AND_LENGTH (p, len);
+ int len;
+ count = string_char_and_length (p, &len);
if (count < 128)
count = 1;
else
diff --git a/src/cmds.c b/src/cmds.c
index c342cd8..9f96f21 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -389,7 +389,7 @@ internal_self_insert (int c, EMACS_INT n)
/* We will delete too many columns. Let's fill columns
by spaces so that the remaining text won't move. */
ptrdiff_t actual = PT_BYTE;
- DEC_POS (actual);
+ actual -= prev_char_len (actual);
if (FETCH_CHAR (actual) == '\t')
/* Rather than add spaces, let's just keep the tab. */
chars_to_delete--;
diff --git a/src/coding.c b/src/coding.c
index 0daa390..34f36d5 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -643,7 +643,7 @@ growable_destination (struct coding_system *coding)
else \
{ \
src--; \
- c = - string_char (src, &src, NULL); \
+ c = - string_char_advance (&src); \
record_conversion_result \
(coding, CODING_RESULT_INVALID_SRC); \
} \
@@ -728,7 +728,7 @@ growable_destination (struct coding_system *coding)
unsigned ch = (c); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
} \
else \
*dst++ = (c); \
@@ -747,11 +747,11 @@ growable_destination (struct coding_system *coding)
ch = (c1); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
ch = (c2); \
if (ch >= 0x80) \
ch = BYTE8_TO_CHAR (ch); \
- CHAR_STRING_ADVANCE (ch, dst); \
+ dst += CHAR_STRING (ch, dst); \
} \
else \
{ \
@@ -884,18 +884,18 @@ record_conversion_result (struct coding_system *coding,
/* Store multibyte form of the character C in P, and advance P to the
- end of the multibyte form. This used to be like CHAR_STRING_ADVANCE
+ end of the multibyte form. This used to be like adding CHAR_STRING
without ever calling MAYBE_UNIFY_CHAR, but nowadays we don't call
- MAYBE_UNIFY_CHAR in CHAR_STRING_ADVANCE. */
+ MAYBE_UNIFY_CHAR in CHAR_STRING. */
-#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) CHAR_STRING_ADVANCE(c, p)
+#define CHAR_STRING_ADVANCE_NO_UNIFY(c, p) ((p) += CHAR_STRING (c, p))
/* Return the character code of character whose multibyte form is at
P, and advance P to the end of the multibyte form. This used to be
- like STRING_CHAR_ADVANCE without ever calling MAYBE_UNIFY_CHAR, but
- nowadays STRING_CHAR_ADVANCE doesn't call MAYBE_UNIFY_CHAR. */
+ like string_char_advance without ever calling MAYBE_UNIFY_CHAR, but
+ nowadays string_char_advance doesn't call MAYBE_UNIFY_CHAR. */
-#define STRING_CHAR_ADVANCE_NO_UNIFY(p) STRING_CHAR_ADVANCE(p)
+#define STRING_CHAR_ADVANCE_NO_UNIFY(p) string_char_advance (&(p))
/* Set coding->source from coding->src_object. */
@@ -5131,7 +5131,7 @@ decode_coding_ccl (struct coding_system *coding)
while (i < 1024 && p < src_end)
{
source_byteidx[i] = p - src;
- source_charbuf[i++] = STRING_CHAR_ADVANCE (p);
+ source_charbuf[i++] = string_char_advance (&p);
}
source_byteidx[i] = p - src;
}
@@ -5308,15 +5308,10 @@ encode_coding_raw_text (struct coding_system *coding)
}
else
{
- unsigned char str[MAX_MULTIBYTE_LENGTH], *p0 = str, *p1 = str;
-
- CHAR_STRING_ADVANCE (c, p1);
- do
- {
- EMIT_ONE_BYTE (*p0);
- p0++;
- }
- while (p0 < p1);
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
+ int len = CHAR_STRING (c, str);
+ for (int i = 0; i < len; i++)
+ EMIT_ONE_BYTE (str[i]);
}
}
else
@@ -5342,7 +5337,7 @@ encode_coding_raw_text (struct coding_system *coding)
else if (CHAR_BYTE8_P (c))
*dst++ = CHAR_TO_BYTE8 (c);
else
- CHAR_STRING_ADVANCE (c, dst);
+ dst += CHAR_STRING (c, dst);
}
}
else
@@ -7457,7 +7452,7 @@ decode_coding (struct coding_system *coding)
if (coding->src_multibyte
&& CHAR_BYTE8_HEAD_P (*src) && nbytes > 0)
{
- c = STRING_CHAR_ADVANCE (src);
+ c = string_char_advance (&src);
nbytes--;
}
else
@@ -7551,10 +7546,8 @@ handle_composition_annotation (ptrdiff_t pos, ptrdiff_t
limit,
len = SCHARS (components);
i = i_byte = 0;
while (i < len)
- {
- FETCH_STRING_CHAR_ADVANCE (*buf, components, i, i_byte);
- buf++;
- }
+ *buf++ = fetch_string_char_advance (components,
+ &i, &i_byte);
}
else if (FIXNUMP (components))
{
@@ -7677,15 +7670,17 @@ consume_chars (struct coding_system *coding,
Lisp_Object translation_table,
if (! multibytep)
{
- int bytes;
-
if (coding->encoder == encode_coding_raw_text
|| coding->encoder == encode_coding_ccl)
c = *src++, pos++;
- else if ((bytes = MULTIBYTE_LENGTH (src, src_end)) > 0)
- c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes;
else
- c = BYTE8_TO_CHAR (*src), src++, pos++;
+ {
+ int bytes = multibyte_length (src, src_end, true, true);
+ if (0 < bytes)
+ c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos += bytes;
+ else
+ c = BYTE8_TO_CHAR (*src), src++, pos++;
+ }
}
else
c = STRING_CHAR_ADVANCE_NO_UNIFY (src), pos++;
@@ -7715,7 +7710,7 @@ consume_chars (struct coding_system *coding, Lisp_Object
translation_table,
lookup_buf[0] = c;
for (i = 1; i < max_lookup && p < src_end; i++)
- lookup_buf[i] = STRING_CHAR_ADVANCE (p);
+ lookup_buf[i] = string_char_advance (&p);
lookup_buf_end = lookup_buf + i;
trans = get_translation (trans, lookup_buf, lookup_buf_end,
&from_nchars);
@@ -7734,7 +7729,7 @@ consume_chars (struct coding_system *coding, Lisp_Object
translation_table,
for (i = 1; i < to_nchars; i++)
*buf++ = XFIXNUM (AREF (trans, i));
for (i = 1; i < from_nchars; i++, pos++)
- src += MULTIBYTE_LENGTH_NO_CHECK (src);
+ src += multibyte_length (src, NULL, false, true);
}
}
@@ -9075,7 +9070,7 @@ DEFUN ("find-coding-systems-region-internal",
p++;
else
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
if (!NILP (char_table_ref (work_table, c)))
/* This character was already checked. Ignore it. */
continue;
@@ -9208,7 +9203,7 @@ to the string and treated as in `substring'. */)
p = GAP_END_ADDR;
}
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
if (! (ASCII_CHAR_P (c) && ascii_compatible)
&& ! char_charset (translate_char (translation_table, c),
charset_list, NULL))
@@ -9326,7 +9321,7 @@ is nil. */)
p++;
else
{
- c = STRING_CHAR_ADVANCE (p);
+ c = string_char_advance (&p);
charset_map_loaded = 0;
for (tail = list; CONSP (tail); tail = XCDR (tail))
@@ -9728,7 +9723,7 @@ encode_string_utf_8 (Lisp_Object string, Lisp_Object
buffer,
|| (len == 2 ? ! CHAR_BYTE8_HEAD_P (c)
: (EQ (handle_over_uni, Qt)
|| (len == 4
- && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR))))
+ && STRING_CHAR (p) <= MAX_UNICODE_CHAR))))
{
p += len;
continue;
@@ -10010,8 +10005,7 @@ decode_string_utf_8 (Lisp_Object string, const char
*str, ptrdiff_t str_len,
&& (len == 3
|| (UTF_8_EXTRA_OCTET_P (p[3])
&& len == 4
- && (string_char (p, NULL, NULL)
- <= MAX_UNICODE_CHAR))))))
+ && STRING_CHAR (p) <= MAX_UNICODE_CHAR)))))
{
p += len;
continue;
@@ -10148,8 +10142,7 @@ decode_string_utf_8 (Lisp_Object string, const char
*str, ptrdiff_t str_len,
mlen++);
if (mlen == len
&& (len <= 3
- || (len == 4
- && string_char (p, NULL, NULL) <= MAX_UNICODE_CHAR)
+ || (len == 4 && STRING_CHAR (p) <= MAX_UNICODE_CHAR)
|| EQ (handle_over_uni, Qt)))
{
p += len;
diff --git a/src/composite.c b/src/composite.c
index a00a454..518502b 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -170,7 +170,6 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
ptrdiff_t hash_index;
enum composition_method method;
struct composition *cmp;
- ptrdiff_t i;
int ch;
/* Maximum length of a string of glyphs. XftGlyphExtents limits
@@ -224,15 +223,15 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
{
key = make_uninit_vector (nchars);
if (STRINGP (string))
- for (i = 0; i < nchars; i++)
+ for (ptrdiff_t i = 0; i < nchars; i++)
{
- FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
+ ch = fetch_string_char_advance (string, &charpos, &bytepos);
ASET (key, i, make_fixnum (ch));
}
else
- for (i = 0; i < nchars; i++)
+ for (ptrdiff_t i = 0; i < nchars; i++)
{
- FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
+ ch = fetch_char_advance (&charpos, &bytepos);
ASET (key, i, make_fixnum (ch));
}
}
@@ -273,7 +272,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
/* COMPONENTS is a glyph-string. */
ptrdiff_t len = ASIZE (key);
- for (i = 1; i < len; i++)
+ for (ptrdiff_t i = 1; i < len; i++)
if (! VECTORP (AREF (key, i)))
goto invalid_composition;
}
@@ -286,7 +285,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
goto invalid_composition;
/* All elements should be integers (character or encoded
composition rule). */
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
if (!FIXNUMP (key_contents[i]))
goto invalid_composition;
@@ -328,7 +327,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
{
/* Relative composition. */
cmp->width = 0;
- for (i = 0; i < glyph_len; i++)
+ for (ptrdiff_t i = 0; i < glyph_len; i++)
{
int this_width;
ch = XFIXNUM (key_contents[i]);
@@ -347,7 +346,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos,
ptrdiff_t nchars,
ch = XFIXNUM (key_contents[0]);
rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
- for (i = 1; i < glyph_len; i += 2)
+ for (ptrdiff_t i = 1; i < glyph_len; i += 2)
{
int rule, gref, nref;
int this_width;
@@ -800,12 +799,10 @@ fill_gstring_header (ptrdiff_t from, ptrdiff_t from_byte,
ASET (header, 0, font_object);
for (ptrdiff_t i = 0; i < len; i++)
{
- int c;
-
- if (NILP (string))
- FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
- else
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
+ int c
+ = (NILP (string)
+ ? fetch_char_advance_no_check (&from, &from_byte)
+ : fetch_string_char_advance_no_check (string, &from, &from_byte));
ASET (header, i + 1, make_fixnum (c));
}
return header;
@@ -1012,10 +1009,9 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
/* Forward search. */
while (charpos < endpos)
{
- if (STRINGP (string))
- FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
- else
- FETCH_CHAR_ADVANCE (c, charpos, bytepos);
+ c = (STRINGP (string)
+ ? fetch_string_char_advance (string, &charpos, &bytepos)
+ : fetch_char_advance (&charpos, &bytepos));
if (c == '\n')
{
cmp_it->ch = -2;
@@ -1070,7 +1066,7 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
p = BYTE_POS_ADDR (bytepos);
else
p = SDATA (string) + bytepos;
- c = STRING_CHAR_AND_LENGTH (p, len);
+ c = string_char_and_length (p, &len);
limit = bytepos + len;
while (char_composable_p (c))
{
@@ -1132,7 +1128,7 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
}
else
{
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
p = BYTE_POS_ADDR (bytepos);
}
c = STRING_CHAR (p);
@@ -1145,7 +1141,7 @@ composition_compute_stop_pos (struct composition_it
*cmp_it, ptrdiff_t charpos,
{
while (charpos - 1 > endpos && ! char_composable_p (c))
{
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
c = FETCH_MULTIBYTE_CHAR (bytepos);
}
}
@@ -1290,7 +1286,7 @@ composition_reseat_it (struct composition_it *cmp_it,
ptrdiff_t charpos,
{
charpos++;
if (NILP (string))
- INC_POS (bytepos);
+ bytepos += next_char_len (bytepos);
else
bytepos += BYTES_BY_CHAR_HEAD (*(SDATA (string) + bytepos));
}
diff --git a/src/conf_post.h b/src/conf_post.h
index 79fb4cf..8a6b329 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -290,6 +290,7 @@ extern int emacs_setenv_TZ (char const *);
#define ARG_NONNULL _GL_ARG_NONNULL
#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
#define ATTRIBUTE_UNUSED _GL_UNUSED
#if GNUC_PREREQ (3, 3, 0) && !defined __ICC
diff --git a/src/dispextern.h b/src/dispextern.h
index ae994d7..d6fe68c 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -234,7 +234,7 @@ struct text_pos
{ \
++(POS).charpos; \
if (MULTIBYTE_P) \
- INC_POS ((POS).bytepos); \
+ (POS).bytepos += next_char_len ((POS).bytepos); \
else \
++(POS).bytepos; \
} \
@@ -247,7 +247,7 @@ struct text_pos
{ \
--(POS).charpos; \
if (MULTIBYTE_P) \
- DEC_POS ((POS).bytepos); \
+ (POS).bytepos -= prev_char_len ((POS).bytepos); \
else \
--(POS).bytepos; \
} \
diff --git a/src/editfns.c b/src/editfns.c
index 90520d0..1a199ba 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -999,7 +999,7 @@ At the beginning of the buffer or accessible region, return
0. */)
else if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
ptrdiff_t pos = PT_BYTE;
- DEC_POS (pos);
+ pos -= prev_char_len (pos);
XSETFASTINT (temp, FETCH_CHAR (pos));
}
else
@@ -1112,7 +1112,7 @@ If POS is out of range, the value is nil. */)
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- DEC_POS (pos_byte);
+ pos_byte -= prev_char_len (pos_byte);
XSETFASTINT (val, FETCH_CHAR (pos_byte));
}
else
@@ -1549,7 +1549,7 @@ from adjoining text, if those properties are sticky. */)
make_uninit_string, which can cause the buffer arena to be
compacted. make_string has no way of knowing that the data has
been moved, and thus copies the wrong data into the string. This
- doesn't effect most of the other users of make_string, so it should
+ doesn't affect most of the other users of make_string, so it should
be left as is. But we should use this function when conjuring
buffer substrings. */
@@ -1830,26 +1830,24 @@ determines whether case is significant or ignored. */)
if (! NILP (BVAR (bp1, enable_multibyte_characters)))
{
c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte);
- BUF_INC_POS (bp1, i1_byte);
+ i1_byte += buf_next_char_len (bp1, i1_byte);
i1++;
}
else
{
- c1 = BUF_FETCH_BYTE (bp1, i1);
- MAKE_CHAR_MULTIBYTE (c1);
+ c1 = make_char_multibyte (BUF_FETCH_BYTE (bp1, i1));
i1++;
}
if (! NILP (BVAR (bp2, enable_multibyte_characters)))
{
c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte);
- BUF_INC_POS (bp2, i2_byte);
+ i2_byte += buf_next_char_len (bp2, i2_byte);
i2++;
}
else
{
- c2 = BUF_FETCH_BYTE (bp2, i2);
- MAKE_CHAR_MULTIBYTE (c2);
+ c2 = make_char_multibyte (BUF_FETCH_BYTE (bp2, i2));
i2++;
}
@@ -2304,7 +2302,7 @@ Both characters must have the same length of multi-byte
form. */)
}
p = BYTE_POS_ADDR (pos_byte);
if (multibyte_p)
- INC_POS (pos_byte_next);
+ pos_byte_next += next_char_len (pos_byte_next);
else
++pos_byte_next;
if (pos_byte_next - pos_byte == len
@@ -2365,7 +2363,7 @@ Both characters must have the same length of multi-byte
form. */)
decrease it now. */
pos--;
else
- INC_POS (pos_byte_next);
+ pos_byte_next += next_char_len (pos_byte_next);
if (! NILP (noundo))
bset_undo_list (current_buffer, tem);
@@ -2442,7 +2440,7 @@ check_translation (ptrdiff_t pos, ptrdiff_t pos_byte,
ptrdiff_t end,
memcpy (bufalloc, buf, sizeof initial_buf);
buf = bufalloc;
}
- buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1);
+ buf[buf_used++] = string_char_and_length (p, &len1);
pos_byte += len1;
}
if (XFIXNUM (AREF (elt, i)) != buf[i])
@@ -2501,13 +2499,13 @@ It returns the number of characters changed. */)
int len, oc;
if (multibyte)
- oc = STRING_CHAR_AND_LENGTH (p, len);
+ oc = string_char_and_length (p, &len);
else
oc = *p, len = 1;
if (oc < translatable_chars)
{
int nc; /* New character. */
- int str_len;
+ int str_len UNINIT;
Lisp_Object val;
if (STRINGP (table))
@@ -2518,7 +2516,7 @@ It returns the number of characters changed. */)
if (string_multibyte)
{
str = tt + string_char_to_byte (table, oc);
- nc = STRING_CHAR_AND_LENGTH (str, str_len);
+ nc = string_char_and_length (str, &str_len);
}
else
{
diff --git a/src/eval.c b/src/eval.c
index 6de81e5..1091b08 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1238,7 +1238,7 @@ The car of a handler may be a list of condition names
instead of a
single condition name; then it handles all of them. If the special
condition name `debug' is present in this list, it allows another
condition in the list to run the debugger if `debug-on-error' and the
-other usual mechanisms says it should (otherwise, `condition-case'
+other usual mechanisms say it should (otherwise, `condition-case'
suppresses the debugger).
When a handler handles an error, control returns to the `condition-case'
diff --git a/src/fns.c b/src/fns.c
index 138082e..ec0004d 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -226,12 +226,12 @@ Letter-case is significant, but text properties are
ignored. */)
for (x = 1; x <= len2; x++)
{
column[0] = x;
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
+ c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
i1 = i1_byte = 0;
for (y = 1, lastdiag = x - 1; y <= len1; y++)
{
olddiag = column[y];
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
+ c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
column[y] = min (min (column[y] + 1, column[y-1] + 1),
lastdiag + (c1 == c2 ? 0 : 1));
lastdiag = olddiag;
@@ -312,10 +312,8 @@ If string STR1 is greater, the value is a positive number
N;
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c1, str1, i1, i1_byte);
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c2, str2, i2, i2_byte);
+ int c1 = fetch_string_char_as_multibyte_advance (str1, &i1, &i1_byte);
+ int c2 = fetch_string_char_as_multibyte_advance (str2, &i2, &i2_byte);
if (c1 == c2)
continue;
@@ -350,11 +348,8 @@ DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2,
0,
doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic
order.
Case is significant.
Symbols are also allowed; their print names are used instead. */)
- (register Lisp_Object string1, Lisp_Object string2)
+ (Lisp_Object string1, Lisp_Object string2)
{
- register ptrdiff_t end;
- register ptrdiff_t i1, i1_byte, i2, i2_byte;
-
if (SYMBOLP (string1))
string1 = SYMBOL_NAME (string1);
if (SYMBOLP (string2))
@@ -362,21 +357,15 @@ Symbols are also allowed; their print names are used
instead. */)
CHECK_STRING (string1);
CHECK_STRING (string2);
- i1 = i1_byte = i2 = i2_byte = 0;
-
- end = SCHARS (string1);
- if (end > SCHARS (string2))
- end = SCHARS (string2);
+ ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
+ ptrdiff_t end = min (SCHARS (string1), SCHARS (string2));
while (i1 < end)
{
/* When we find a mismatch, we must compare the
characters, not just the bytes. */
- int c1, c2;
-
- FETCH_STRING_CHAR_ADVANCE (c1, string1, i1, i1_byte);
- FETCH_STRING_CHAR_ADVANCE (c2, string2, i2, i2_byte);
-
+ int c1 = fetch_string_char_advance (string1, &i1, &i1_byte);
+ int c2 = fetch_string_char_advance (string2, &i2, &i2_byte);
if (c1 != c2)
return c1 < c2 ? Qt : Qnil;
}
@@ -767,8 +756,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
Lisp_Object thislen;
ptrdiff_t thisleni = 0;
- register ptrdiff_t thisindex = 0;
- register ptrdiff_t thisindex_byte = 0;
+ ptrdiff_t thisindex = 0;
+ ptrdiff_t thisindex_byte = 0;
this = args[argnum];
if (!CONSP (this))
@@ -821,9 +810,8 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
int c;
if (STRING_MULTIBYTE (this))
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, this,
- thisindex,
- thisindex_byte);
+ c = fetch_string_char_advance_no_check (this, &thisindex,
+ &thisindex_byte);
else
{
c = SREF (this, thisindex); thisindex++;
@@ -1961,9 +1949,7 @@ See also the function `nreverse', which is used more
often. */)
p = SDATA (seq), q = SDATA (new) + bytes;
while (q > SDATA (new))
{
- int ch, len;
-
- ch = STRING_CHAR_AND_LENGTH (p, len);
+ int len, ch = string_char_and_length (p, &len);
p += len, q -= len;
CHAR_STRING (ch, q);
}
@@ -2614,51 +2600,45 @@ usage: (nconc &rest LISTS) */)
static EMACS_INT
mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)
{
- Lisp_Object tail, dummy;
- EMACS_INT i;
-
if (VECTORP (seq) || COMPILEDP (seq))
{
- for (i = 0; i < leni; i++)
+ for (ptrdiff_t i = 0; i < leni; i++)
{
- dummy = call1 (fn, AREF (seq, i));
+ Lisp_Object dummy = call1 (fn, AREF (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (BOOL_VECTOR_P (seq))
{
- for (i = 0; i < leni; i++)
+ for (EMACS_INT i = 0; i < leni; i++)
{
- dummy = call1 (fn, bool_vector_ref (seq, i));
+ Lisp_Object dummy = call1 (fn, bool_vector_ref (seq, i));
if (vals)
vals[i] = dummy;
}
}
else if (STRINGP (seq))
{
- ptrdiff_t i_byte;
+ ptrdiff_t i_byte = 0;
- for (i = 0, i_byte = 0; i < leni;)
+ for (ptrdiff_t i = 0; i < leni;)
{
- int c;
ptrdiff_t i_before = i;
-
- FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte);
- XSETFASTINT (dummy, c);
- dummy = call1 (fn, dummy);
+ int c = fetch_string_char_advance (seq, &i, &i_byte);
+ Lisp_Object dummy = call1 (fn, make_fixnum (c));
if (vals)
vals[i_before] = dummy;
}
}
else /* Must be a list, since Flength did not get an error */
{
- tail = seq;
- for (i = 0; i < leni; i++)
+ Lisp_Object tail = seq;
+ for (ptrdiff_t i = 0; i < leni; i++)
{
if (! CONSP (tail))
return i;
- dummy = call1 (fn, XCAR (tail));
+ Lisp_Object dummy = call1 (fn, XCAR (tail));
if (vals)
vals[i] = dummy;
tail = XCDR (tail);
@@ -3451,7 +3431,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
{
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3494,7 +3474,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3519,7 +3499,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
if (multibyte)
{
- c = STRING_CHAR_AND_LENGTH ((unsigned char *) from + i, bytes);
+ c = string_char_and_length ((unsigned char *) from + i, &bytes);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (c >= 256)
@@ -3700,7 +3680,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = value >> 16 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3742,7 +3722,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = value >> 8 & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
@@ -3772,7 +3752,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = value & 0xff;
if (c & multibyte_bit)
- e += BYTE8_STRING (c, e);
+ e += BYTE8_STRING (c, (unsigned char *) e);
else
*e++ = c;
nchars++;
diff --git a/src/font.c b/src/font.c
index 0c9e752..ab00402 100644
--- a/src/font.c
+++ b/src/font.c
@@ -3856,13 +3856,10 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte,
ptrdiff_t *limit,
while (pos < *limit)
{
- Lisp_Object category;
-
- if (NILP (string))
- FETCH_CHAR_ADVANCE_NO_CHECK (c, pos, pos_byte);
- else
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte);
- category = CHAR_TABLE_REF (Vunicode_category_table, c);
+ c = (NILP (string)
+ ? fetch_char_advance_no_check (&pos, &pos_byte)
+ : fetch_string_char_advance_no_check (string, &pos, &pos_byte));
+ Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (FIXNUMP (category)
&& (XFIXNUM (category) == UNICODE_CATEGORY_Cf
|| CHAR_VARIATION_SELECTOR_P (c)))
@@ -4891,7 +4888,7 @@ the corresponding element is nil. */)
Lisp_Object object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- ptrdiff_t i, len;
+ ptrdiff_t len;
Lisp_Object *chars, vec;
USE_SAFE_ALLOCA;
@@ -4906,10 +4903,9 @@ the corresponding element is nil. */)
SAFE_ALLOCA_LISP (chars, len);
charpos = XFIXNAT (from);
bytepos = CHAR_TO_BYTE (charpos);
- for (i = 0; charpos < XFIXNAT (to); i++)
+ for (ptrdiff_t i = 0; charpos < XFIXNAT (to); i++)
{
- int c;
- FETCH_CHAR_ADVANCE (c, charpos, bytepos);
+ int c = fetch_char_advance (&charpos, &bytepos);
chars[i] = make_fixnum (c);
}
}
@@ -4929,18 +4925,18 @@ the corresponding element is nil. */)
int c;
/* Skip IFROM characters from the beginning. */
- for (i = 0; i < ifrom; i++)
- c = STRING_CHAR_ADVANCE (p);
+ for (ptrdiff_t i = 0; i < ifrom; i++)
+ p += BYTES_BY_CHAR_HEAD (*p);
/* Now fetch an interesting characters. */
- for (i = 0; i < len; i++)
- {
- c = STRING_CHAR_ADVANCE (p);
- chars[i] = make_fixnum (c);
- }
+ for (ptrdiff_t i = 0; i < len; i++)
+ {
+ c = string_char_advance (&p);
+ chars[i] = make_fixnum (c);
+ }
}
else
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
chars[i] = make_fixnum (p[ifrom + i]);
}
else if (VECTORP (object))
@@ -4951,7 +4947,7 @@ the corresponding element is nil. */)
if (ifrom == ito)
return Qnil;
len = ito - ifrom;
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object elt = AREF (object, ifrom + i);
CHECK_CHARACTER (elt);
@@ -4962,7 +4958,7 @@ the corresponding element is nil. */)
wrong_type_argument (Qarrayp, object);
vec = make_uninit_vector (len);
- for (i = 0; i < len; i++)
+ for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object g;
int c = XFIXNAT (chars[i]);
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index a0e18e1..7832d4f 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -328,14 +328,13 @@ ftcrfont_encode_char (struct font *font, int c)
struct font_info *ftcrfont_info = (struct font_info *) font;
unsigned code = FONT_INVALID_CODE;
unsigned char utf8[MAX_MULTIBYTE_LENGTH];
- unsigned char *p = utf8;
+ int utf8len = CHAR_STRING (c, utf8);
cairo_glyph_t stack_glyph;
cairo_glyph_t *glyphs = &stack_glyph;
int num_glyphs = 1;
- CHAR_STRING_ADVANCE (c, p);
if (cairo_scaled_font_text_to_glyphs (ftcrfont_info->cr_scaled_font, 0, 0,
- (char *) utf8, p - utf8,
+ (char *) utf8, utf8len,
&glyphs, &num_glyphs,
NULL, NULL, NULL)
== CAIRO_STATUS_SUCCESS)
diff --git a/src/image.c b/src/image.c
index acb1e9d..ffe2f60 100644
--- a/src/image.c
+++ b/src/image.c
@@ -24,7 +24,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
/* Include this before including <setjmp.h> to work around bugs with
older libpng; see Bug#17429. */
-#if defined HAVE_PNG && !defined HAVE_NS
+#if defined HAVE_PNG
# include <png.h>
#endif
@@ -125,6 +125,7 @@ typedef struct ns_bitmap_record Bitmap_Record;
#define NO_PIXMAP 0
#define PIX_MASK_RETAIN 0
+#define PIX_MASK_DRAW 1
#endif /* HAVE_NS */
@@ -6242,6 +6243,8 @@ image_can_use_native_api (Lisp_Object type)
{
# ifdef HAVE_NTGUI
return w32_can_use_native_image_api (type);
+# elif defined HAVE_NS
+ return ns_can_use_native_image_api (type);
# else
return false;
# endif
@@ -6310,6 +6313,10 @@ native_image_load (struct frame *f, struct image *img)
return w32_load_image (f, img,
image_spec_value (img->spec, QCfile, NULL),
image_spec_value (img->spec, QCdata, NULL));
+# elif defined HAVE_NS
+ return ns_load_image (f, img,
+ image_spec_value (img->spec, QCfile, NULL),
+ image_spec_value (img->spec, QCdata, NULL));
# else
return 0;
# endif
@@ -6322,7 +6329,7 @@ native_image_load (struct frame *f, struct image *img)
PNG
***********************************************************************/
-#if defined (HAVE_PNG) || defined (HAVE_NS)
+#if defined (HAVE_PNG)
/* Indices of image specification fields in png_format, below. */
@@ -6373,10 +6380,10 @@ png_image_p (Lisp_Object object)
return fmt[PNG_FILE].count + fmt[PNG_DATA].count == 1;
}
-#endif /* HAVE_PNG || HAVE_NS */
+#endif /* HAVE_PNG */
-#if defined HAVE_PNG && !defined HAVE_NS
+#ifdef HAVE_PNG
# ifdef WINDOWSNT
/* PNG library details. */
@@ -6966,17 +6973,7 @@ png_load (struct frame *f, struct image *img)
return png_load_body (f, img, &c);
}
-#elif defined HAVE_NS
-
-static bool
-png_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-
-#endif /* HAVE_NS */
+#endif /* HAVE_PNG */
@@ -6984,7 +6981,7 @@ png_load (struct frame *f, struct image *img)
JPEG
***********************************************************************/
-#if defined (HAVE_JPEG) || defined (HAVE_NS)
+#if defined (HAVE_JPEG)
/* Indices of image specification fields in gs_format, below. */
@@ -7036,7 +7033,7 @@ jpeg_image_p (Lisp_Object object)
return fmt[JPEG_FILE].count + fmt[JPEG_DATA].count == 1;
}
-#endif /* HAVE_JPEG || HAVE_NS */
+#endif /* HAVE_JPEG */
#ifdef HAVE_JPEG
@@ -7538,18 +7535,6 @@ jpeg_load (struct frame *f, struct image *img)
return jpeg_load_body (f, img, &mgr);
}
-#else /* HAVE_JPEG */
-
-#ifdef HAVE_NS
-static bool
-jpeg_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-#endif /* HAVE_NS */
-
#endif /* !HAVE_JPEG */
@@ -7558,7 +7543,7 @@ jpeg_load (struct frame *f, struct image *img)
TIFF
***********************************************************************/
-#if defined (HAVE_TIFF) || defined (HAVE_NS)
+#if defined (HAVE_TIFF)
/* Indices of image specification fields in tiff_format, below. */
@@ -7611,7 +7596,7 @@ tiff_image_p (Lisp_Object object)
return fmt[TIFF_FILE].count + fmt[TIFF_DATA].count == 1;
}
-#endif /* HAVE_TIFF || HAVE_NS */
+#endif /* HAVE_TIFF */
#ifdef HAVE_TIFF
@@ -7979,16 +7964,6 @@ tiff_load (struct frame *f, struct image *img)
return 1;
}
-#elif defined HAVE_NS
-
-static bool
-tiff_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-
#endif
@@ -7997,7 +7972,7 @@ tiff_load (struct frame *f, struct image *img)
GIF
***********************************************************************/
-#if defined (HAVE_GIF) || defined (HAVE_NS)
+#if defined (HAVE_GIF)
/* Indices of image specification fields in gif_format, below. */
@@ -8059,7 +8034,7 @@ gif_image_p (Lisp_Object object)
return fmt[GIF_FILE].count + fmt[GIF_DATA].count == 1;
}
-#endif /* HAVE_GIF || HAVE_NS */
+#endif /* HAVE_GIF */
#ifdef HAVE_GIF
@@ -8576,18 +8551,6 @@ gif_load (struct frame *f, struct image *img)
return 1;
}
-#else /* !HAVE_GIF */
-
-#ifdef HAVE_NS
-static bool
-gif_load (struct frame *f, struct image *img)
-{
- return ns_load_image (f, img,
- image_spec_value (img->spec, QCfile, NULL),
- image_spec_value (img->spec, QCdata, NULL));
-}
-#endif /* HAVE_NS */
-
#endif /* HAVE_GIF */
@@ -10256,19 +10219,19 @@ static struct image_type const image_types[] =
{ SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image,
IMAGE_TYPE_INIT (init_svg_functions) },
#endif
-#if defined HAVE_PNG || defined HAVE_NS
+#if defined HAVE_PNG
{ SYMBOL_INDEX (Qpng), png_image_p, png_load, image_clear_image,
IMAGE_TYPE_INIT (init_png_functions) },
#endif
-#if defined HAVE_GIF || defined HAVE_NS
+#if defined HAVE_GIF
{ SYMBOL_INDEX (Qgif), gif_image_p, gif_load, gif_clear_image,
IMAGE_TYPE_INIT (init_gif_functions) },
#endif
-#if defined HAVE_TIFF || defined HAVE_NS
+#if defined HAVE_TIFF
{ SYMBOL_INDEX (Qtiff), tiff_image_p, tiff_load, image_clear_image,
IMAGE_TYPE_INIT (init_tiff_functions) },
#endif
-#if defined HAVE_JPEG || defined HAVE_NS
+#if defined HAVE_JPEG
{ SYMBOL_INDEX (Qjpeg), jpeg_image_p, jpeg_load, image_clear_image,
IMAGE_TYPE_INIT (init_jpeg_functions) },
#endif
@@ -10418,22 +10381,22 @@ non-numeric, there is no explicit limit on the size
of images. */);
add_image_type (Qxpm);
#endif
-#if defined (HAVE_JPEG) || defined (HAVE_NS) || defined (HAVE_NATIVE_IMAGE_API)
+#if defined (HAVE_JPEG) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qjpeg, "jpeg");
add_image_type (Qjpeg);
#endif
-#if defined (HAVE_TIFF) || defined (HAVE_NS) || defined (HAVE_NATIVE_IMAGE_API)
+#if defined (HAVE_TIFF) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qtiff, "tiff");
add_image_type (Qtiff);
#endif
-#if defined (HAVE_GIF) || defined (HAVE_NS) || defined (HAVE_NATIVE_IMAGE_API)
+#if defined (HAVE_GIF) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qgif, "gif");
add_image_type (Qgif);
#endif
-#if defined (HAVE_PNG) || defined (HAVE_NS) || defined(HAVE_NATIVE_IMAGE_API)
+#if defined (HAVE_PNG) || defined (HAVE_NATIVE_IMAGE_API)
DEFSYM (Qpng, "png");
add_image_type (Qpng);
#endif
diff --git a/src/indent.c b/src/indent.c
index 06f11a2..c0b4c13b 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -285,9 +285,7 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p,
ptrdiff_t to, Lisp_Ob
#define MULTIBYTE_BYTES_WIDTH(p, dp, bytes, width) \
do { \
- int ch; \
- \
- ch = STRING_CHAR_AND_LENGTH (p, bytes); \
+ int ch = string_char_and_length (p, &(bytes)); \
if (BYTES_BY_CHAR_HEAD (*p) != bytes) \
width = bytes * 4; \
else \
@@ -942,7 +940,7 @@ position_indentation (ptrdiff_t pos_byte)
if (CHAR_HAS_CATEGORY (c, ' '))
{
column++;
- INC_POS (pos_byte);
+ pos_byte += next_char_len (pos_byte);
p = BYTE_POS_ADDR (pos_byte);
}
else
@@ -961,7 +959,7 @@ indented_beyond_p (ptrdiff_t pos, ptrdiff_t pos_byte,
EMACS_INT column)
{
while (pos > BEGV && FETCH_BYTE (pos_byte) == '\n')
{
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
pos = find_newline (pos, pos_byte, BEGV, BEGV_BYTE,
-1, NULL, &pos_byte, 0);
}
@@ -1010,7 +1008,7 @@ The return value is the current column. */)
int c;
ptrdiff_t pos_byte = PT_BYTE;
- DEC_POS (pos_byte);
+ pos_byte -= prev_char_len (pos_byte);
c = FETCH_CHAR (pos_byte);
if (c == '\t' && prev_col < goal)
{
@@ -1605,7 +1603,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
{
pos = find_before_next_newline (pos, to, 1,
&pos_byte);
if (pos < to)
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
rarely_quit (++quit_count);
}
while (pos < to
@@ -1618,7 +1616,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
if (hpos >= width)
hpos = width;
}
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
/* We have skipped the invis text, but not the
newline after. */
}
@@ -1820,8 +1818,8 @@ visible section of the buffer, and pass LINE and COL as
TOPOS. */)
static struct position val_vmotion;
struct position *
-vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
- register EMACS_INT vtarget, struct window *w)
+vmotion (ptrdiff_t from, ptrdiff_t from_byte,
+ EMACS_INT vtarget, struct window *w)
{
ptrdiff_t hscroll = w->hscroll;
struct position pos;
@@ -1862,7 +1860,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t
from_byte,
Lisp_Object propval;
prevline = from;
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
while (prevline > BEGV
@@ -1875,7 +1873,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t
from_byte,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
{
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
@@ -1925,7 +1923,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t
from_byte,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
{
- DEC_BOTH (prevline, bytepos);
+ dec_both (&prevline, &bytepos);
prevline = find_newline_no_quit (prevline, bytepos, -1, &bytepos);
}
pos = *compute_motion (prevline, bytepos, 0, lmargin, 0, from,
diff --git a/src/insdel.c b/src/insdel.c
index dfa1cc3..c37b071 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -382,10 +382,10 @@ count_bytes (ptrdiff_t pos, ptrdiff_t bytepos, ptrdiff_t
endpos)
if (pos <= endpos)
for ( ; pos < endpos; pos++)
- INC_POS (bytepos);
+ bytepos += next_char_len (bytepos);
else
for ( ; pos > endpos; pos--)
- DEC_POS (bytepos);
+ bytepos -= prev_char_len (bytepos);
return bytepos;
}
@@ -626,8 +626,7 @@ copy_text (const unsigned char *from_addr, unsigned char
*to_addr,
while (bytes_left > 0)
{
- int thislen, c;
- c = STRING_CHAR_AND_LENGTH (from_addr, thislen);
+ int thislen, c = string_char_and_length (from_addr, &thislen);
if (! ASCII_CHAR_P (c))
c &= 0xFF;
*to_addr++ = c;
diff --git a/src/keyboard.c b/src/keyboard.c
index b4e62c3..c94d794 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2279,7 +2279,7 @@ read_decoded_event_from_main_queue (struct timespec
*end_time,
eassert (coding->carryover_bytes == 0);
n = 0;
while (n < coding->produced_char)
- events[n++] = make_fixnum (STRING_CHAR_ADVANCE (p));
+ events[n++] = make_fixnum (string_char_advance (&p));
}
}
}
@@ -10466,9 +10466,8 @@ Internal use only. */)
this_command_key_count = 0;
this_single_command_key_start = 0;
- int charidx = 0, byteidx = 0;
- int key0;
- FETCH_STRING_CHAR_ADVANCE (key0, keys, charidx, byteidx);
+ ptrdiff_t charidx = 0, byteidx = 0;
+ int key0 = fetch_string_char_advance (keys, &charidx, &byteidx);
if (CHAR_BYTE8_P (key0))
key0 = CHAR_TO_BYTE8 (key0);
@@ -10480,8 +10479,7 @@ Internal use only. */)
add_command_key (make_fixnum (key0));
for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
{
- int key_i;
- FETCH_STRING_CHAR_ADVANCE (key_i, keys, charidx, byteidx);
+ int key_i = fetch_string_char_advance (keys, &charidx, &byteidx);
if (CHAR_BYTE8_P (key_i))
key_i = CHAR_TO_BYTE8 (key_i);
add_command_key (make_fixnum (key_i));
diff --git a/src/keymap.c b/src/keymap.c
index cfba98c..d98b27b 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1949,8 +1949,7 @@ then the value includes only maps for prefixes that start
with PREFIX. */)
for (ptrdiff_t i = 0; i < SCHARS (prefix); )
{
ptrdiff_t i_before = i;
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
+ int c = fetch_string_char_advance (prefix, &i, &i_byte);
if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
c ^= 0200 | meta_modifier;
ASET (copy, i_before, make_fixnum (c));
@@ -2006,23 +2005,16 @@ For an approximate inverse of this, see `kbd'. */)
(Lisp_Object keys, Lisp_Object prefix)
{
ptrdiff_t len = 0;
- EMACS_INT i;
- ptrdiff_t i_byte;
Lisp_Object *args;
- EMACS_INT size = XFIXNUM (Flength (keys));
- Lisp_Object list;
+ EMACS_INT nkeys = XFIXNUM (Flength (keys));
+ EMACS_INT nprefix = XFIXNUM (Flength (prefix));
Lisp_Object sep = build_string (" ");
- Lisp_Object key;
- Lisp_Object result;
- bool add_meta = 0;
+ bool add_meta = false;
USE_SAFE_ALLOCA;
- if (!NILP (prefix))
- size += XFIXNUM (Flength (prefix));
-
/* This has one extra element at the end that we don't pass to Fconcat. */
- EMACS_INT size4;
- if (INT_MULTIPLY_WRAPV (size, 4, &size4))
+ ptrdiff_t size4;
+ if (INT_MULTIPLY_WRAPV (nkeys + nprefix, 4, &size4))
memory_full (SIZE_MAX);
SAFE_ALLOCA_LISP (args, size4);
@@ -2030,82 +2022,76 @@ For an approximate inverse of this, see `kbd'. */)
(mapconcat 'single-key-description keys " ")
but we shouldn't use mapconcat because it can do GC. */
- next_list:
- if (!NILP (prefix))
- list = prefix, prefix = Qnil;
- else if (!NILP (keys))
- list = keys, keys = Qnil;
- else
+ Lisp_Object lists[2] = { prefix, keys };
+ ptrdiff_t listlens[2] = { nprefix, nkeys };
+ for (int li = 0; li < ARRAYELTS (lists); li++)
{
- if (add_meta)
- {
- args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
- result = Fconcat (len + 1, args);
- }
- else if (len == 0)
- result = empty_unibyte_string;
- else
- result = Fconcat (len - 1, args);
- SAFE_FREE ();
- return result;
- }
+ Lisp_Object list = lists[li];
+ ptrdiff_t listlen = listlens[li], i_byte = 0;
- if (STRINGP (list))
- size = SCHARS (list);
- else if (VECTORP (list))
- size = ASIZE (list);
- else if (CONSP (list))
- size = list_length (list);
- else
- wrong_type_argument (Qarrayp, list);
+ if (! (NILP (list) || STRINGP (list) || VECTORP (list) || CONSP (list)))
+ wrong_type_argument (Qarrayp, list);
- i = i_byte = 0;
-
- while (i < size)
- {
- if (STRINGP (list))
+ for (ptrdiff_t i = 0; i < listlen; )
{
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
- if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
- c ^= 0200 | meta_modifier;
- XSETFASTINT (key, c);
- }
- else if (VECTORP (list))
- {
- key = AREF (list, i); i++;
- }
- else
- {
- key = XCAR (list);
- list = XCDR (list);
- i++;
- }
-
- if (add_meta)
- {
- if (!FIXNUMP (key)
- || EQ (key, meta_prefix_char)
- || (XFIXNUM (key) & meta_modifier))
+ Lisp_Object key;
+ if (STRINGP (list))
{
- args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
- args[len++] = sep;
- if (EQ (key, meta_prefix_char))
- continue;
+ int c = fetch_string_char_advance (list, &i, &i_byte);
+ if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
+ c ^= 0200 | meta_modifier;
+ key = make_fixnum (c);
+ }
+ else if (VECTORP (list))
+ {
+ key = AREF (list, i);
+ i++;
}
else
- XSETINT (key, XFIXNUM (key) | meta_modifier);
- add_meta = 0;
- }
- else if (EQ (key, meta_prefix_char))
- {
- add_meta = 1;
- continue;
+ {
+ key = XCAR (list);
+ list = XCDR (list);
+ i++;
+ }
+
+ if (add_meta)
+ {
+ if (!FIXNUMP (key)
+ || EQ (key, meta_prefix_char)
+ || (XFIXNUM (key) & meta_modifier))
+ {
+ args[len++] = Fsingle_key_description (meta_prefix_char,
+ Qnil);
+ args[len++] = sep;
+ if (EQ (key, meta_prefix_char))
+ continue;
+ }
+ else
+ key = make_fixnum (XFIXNUM (key) | meta_modifier);
+ add_meta = false;
+ }
+ else if (EQ (key, meta_prefix_char))
+ {
+ add_meta = true;
+ continue;
+ }
+ args[len++] = Fsingle_key_description (key, Qnil);
+ args[len++] = sep;
}
- args[len++] = Fsingle_key_description (key, Qnil);
- args[len++] = sep;
}
- goto next_list;
+
+ Lisp_Object result;
+ if (add_meta)
+ {
+ args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
+ result = Fconcat (len + 1, args);
+ }
+ else if (len == 0)
+ result = empty_unibyte_string;
+ else
+ result = Fconcat (len - 1, args);
+ SAFE_FREE ();
+ return result;
}
@@ -2282,12 +2268,6 @@ See `text-char-description' for describing character
codes. */)
static char *
push_text_char_description (register unsigned int c, register char *p)
{
- if (c >= 0200)
- {
- *p++ = 'M';
- *p++ = '-';
- c -= 0200;
- }
if (c < 040)
{
*p++ = '^';
@@ -2316,23 +2296,22 @@ characters into "C-char", and uses the 2**27 bit for
Meta.
See Info node `(elisp)Describing Characters' for examples. */)
(Lisp_Object character)
{
- /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
- char str[6];
- int c;
-
CHECK_CHARACTER (character);
- c = XFIXNUM (character);
+ int c = XFIXNUM (character);
if (!ASCII_CHAR_P (c))
{
+ char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (c, (unsigned char *) str);
return make_multibyte_string (str, 1, len);
}
-
- *push_text_char_description (c & 0377, str) = 0;
-
- return build_string (str);
+ else
+ {
+ char desc[4];
+ int len = push_text_char_description (c, desc) - desc;
+ return make_string (desc, len);
+ }
}
static int where_is_preferred_modifier;
diff --git a/src/lisp.h b/src/lisp.h
index 77c8749..1cec62a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -597,7 +597,7 @@ extern Lisp_Object make_biguint (uintmax_t);
extern uintmax_t check_uinteger_max (Lisp_Object, uintmax_t);
/* Defined in chartab.c. */
-extern Lisp_Object char_table_ref (Lisp_Object, int);
+extern Lisp_Object char_table_ref (Lisp_Object, int) ATTRIBUTE_PURE;
extern void char_table_set (Lisp_Object, int, Lisp_Object);
/* Defined in data.c. */
diff --git a/src/lread.c b/src/lread.c
index 1e05ac6..01f359c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -225,8 +225,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
- BUF_INC_POS (inbuffer, pt_byte);
- c = STRING_CHAR (p);
+ int clen;
+ c = string_char_and_length (p, &clen);
+ pt_byte += clen;
if (multibyte)
*multibyte = 1;
}
@@ -254,8 +255,9 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
/* Fetch the character code from the buffer. */
unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
- BUF_INC_POS (inbuffer, bytepos);
- c = STRING_CHAR (p);
+ int clen;
+ c = string_char_and_length (p, &clen);
+ bytepos += clen;
if (multibyte)
*multibyte = 1;
}
@@ -294,9 +296,10 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
{
if (multibyte)
*multibyte = 1;
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
- read_from_string_index,
- read_from_string_index_byte);
+ c = (fetch_string_char_advance_no_check
+ (readcharfun,
+ &read_from_string_index,
+ &read_from_string_index_byte));
}
else
{
@@ -427,7 +430,7 @@ unreadchar (Lisp_Object readcharfun, int c)
ptrdiff_t bytepos = BUF_PT_BYTE (b);
if (! NILP (BVAR (b, enable_multibyte_characters)))
- BUF_DEC_POS (b, bytepos);
+ bytepos -= buf_prev_char_len (b, bytepos);
else
bytepos--;
@@ -440,7 +443,7 @@ unreadchar (Lisp_Object readcharfun, int c)
XMARKER (readcharfun)->charpos--;
if (! NILP (BVAR (b, enable_multibyte_characters)))
- BUF_DEC_POS (b, bytepos);
+ bytepos -= buf_prev_char_len (b, bytepos);
else
bytepos--;
@@ -526,13 +529,11 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
= string_char_to_byte (string, read_from_string_index);
}
- if (read_from_string_index >= read_from_string_limit)
- c = -1;
- else
- FETCH_STRING_CHAR_ADVANCE (c, string,
- read_from_string_index,
- read_from_string_index_byte);
- return c;
+ return (read_from_string_index < read_from_string_limit
+ ? fetch_string_char_advance (string,
+ &read_from_string_index,
+ &read_from_string_index_byte)
+ : -1);
}
@@ -4951,7 +4952,7 @@ features required. Each entry has the form `(provide .
FEATURE)',
`(defface . SYMBOL)', `(define-type . SYMBOL)',
`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
-and means that SYMBOL was an autoload before this file redefined it
+and mean that SYMBOL was an autoload before this file redefined it
as a function. In addition, entries may also be single symbols,
which means that symbol was defined by `defvar' or `defconst'.
diff --git a/src/marker.c b/src/marker.c
index 684b750..64f210d 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -221,7 +221,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
while (best_below != charpos)
{
best_below++;
- BUF_INC_POS (b, best_below_byte);
+ best_below_byte += buf_next_char_len (b, best_below_byte);
}
/* If this position is quite far from the nearest known position,
@@ -246,7 +246,7 @@ buf_charpos_to_bytepos (struct buffer *b, ptrdiff_t charpos)
while (best_above != charpos)
{
best_above--;
- BUF_DEC_POS (b, best_above_byte);
+ best_above_byte -= buf_prev_char_len (b, best_above_byte);
}
/* If this position is quite far from the nearest known position,
@@ -372,7 +372,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
while (best_below_byte < bytepos)
{
best_below++;
- BUF_INC_POS (b, best_below_byte);
+ best_below_byte += buf_next_char_len (b, best_below_byte);
}
/* If this position is quite far from the nearest known position,
@@ -399,7 +399,7 @@ buf_bytepos_to_charpos (struct buffer *b, ptrdiff_t bytepos)
while (best_above_byte > bytepos)
{
best_above--;
- BUF_DEC_POS (b, best_above_byte);
+ best_above_byte -= buf_prev_char_len (b, best_above_byte);
}
/* If this position is quite far from the nearest known position,
@@ -804,7 +804,7 @@ verify_bytepos (ptrdiff_t charpos)
while (below != charpos)
{
below++;
- BUF_INC_POS (current_buffer, below_byte);
+ below_byte += buf_next_char_len (current_buffer, below_byte);
}
return below_byte;
diff --git a/src/menu.c b/src/menu.c
index 6b8b5dd..e4fda57 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1036,9 +1036,7 @@ menu_item_width (const unsigned char *str)
for (len = 0, p = str; *p; )
{
- int ch_len;
- int ch = STRING_CHAR_AND_LENGTH (p, ch_len);
-
+ int ch_len, ch = string_char_and_length (p, &ch_len);
len += CHARACTER_WIDTH (ch);
p += ch_len;
}
diff --git a/src/msdos.c b/src/msdos.c
index a09b3ba..b5f06c9 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -2905,7 +2905,7 @@ IT_menu_display (XMenu *menu, int y, int x, int pn, int
*faces, int disp_help)
p++;
for (j = 0, q = menu->text[i]; *q; j++)
{
- unsigned c = STRING_CHAR_ADVANCE (q);
+ unsigned c = string_char_advance (&q);
if (c > 26)
{
diff --git a/src/nsfont.m b/src/nsfont.m
index e41a698..691becd 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -1090,7 +1090,7 @@ nsfont_draw (struct glyph_string *s, int from, int to,
int x, int y,
twidth += cwidth;
#ifdef NS_IMPL_GNUSTEP
*adv++ = cwidth;
- CHAR_STRING_ADVANCE (*t, c); /* This converts the char to UTF-8. */
+ c += CHAR_STRING (*t, c); /* This converts the char to UTF-8. */
#else
(*adv++).width = cwidth;
#endif
diff --git a/src/nsimage.m b/src/nsimage.m
index 3cccc98..07750de 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -45,6 +45,55 @@ GNUstep port and post-20 update by Adrian Robert
(address@hidden)
==========================================================================
*/
+bool
+ns_can_use_native_image_api (Lisp_Object type)
+{
+ NSString *imageType = @"unknown";
+ NSArray *types;
+
+ NSTRACE ("ns_can_use_native_image_api");
+
+ if (EQ (type, Qnative_image))
+ return YES;
+
+#ifdef NS_IMPL_COCOA
+ /* Work out the UTI of the image type. */
+ if (EQ (type, Qjpeg))
+ imageType = @"public.jpeg";
+ else if (EQ (type, Qpng))
+ imageType = @"public.png";
+ else if (EQ (type, Qgif))
+ imageType = @"com.compuserve.gif";
+ else if (EQ (type, Qtiff))
+ imageType = @"public.tiff";
+ else if (EQ (type, Qsvg))
+ imageType = @"public.svg-image";
+
+ /* NSImage also supports a host of other types such as PDF and BMP,
+ but we don't yet support these in image.c. */
+
+ types = [NSImage imageTypes];
+#else
+ /* Work out the image type. */
+ if (EQ (type, Qjpeg))
+ imageType = @"jpeg";
+ else if (EQ (type, Qpng))
+ imageType = @"png";
+ else if (EQ (type, Qgif))
+ imageType = @"gif";
+ else if (EQ (type, Qtiff))
+ imageType = @"tiff";
+
+ types = [NSImage imageFileTypes];
+#endif
+
+ /* Check if the type is supported on this system. */
+ if ([types indexOfObject:imageType] != NSNotFound)
+ return YES;
+ else
+ return NO;
+}
+
void *
ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg)
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 67f9a45..b7e4cbd 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1141,8 +1141,6 @@ update_frame_tool_bar (struct frame *f)
}
#endif
- if (oldh != FRAME_TOOLBAR_HEIGHT (f))
- [view updateFrameSize:YES];
if (view->wait_for_tool_bar && FRAME_TOOLBAR_HEIGHT (f) > 0)
{
view->wait_for_tool_bar = NO;
diff --git a/src/nsterm.h b/src/nsterm.h
index 8396a54..8d5371c 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -343,14 +343,8 @@ typedef id instancetype;
therefore we draw to an offscreen buffer and swap it in when the
toolkit wants to draw the frame. GNUstep and macOS 10.7 and below
do not support this method, so we revert to drawing directly to the
- glass.
-
- FIXME: Should we make this macOS 10.8+, or macOS 10.14+? I'm
- inclined to go with 10.14+ as there have been some reports of funny
- behaviour on 10.13 and below. It may be worth adding a variable to
- allow people in the overlapping region to switch between drawing
- paths. */
-#if defined (NS_IMPL_COCOA) && defined (MAC_OS_X_VERSION_10_14)
+ glass. */
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101400
#define NS_DRAW_TO_BUFFER 1
#endif
@@ -439,7 +433,6 @@ typedef id instancetype;
#endif
@public
struct frame *emacsframe;
- int rows, cols;
int scrollbarsNeedingUpdate;
EmacsToolbar *toolbar;
NSRect ns_userRect;
@@ -458,11 +451,9 @@ typedef id instancetype;
/* Emacs-side interface */
- (instancetype) initFrameFromEmacs: (struct frame *) f;
- (void) createToolbar: (struct frame *)f;
-- (void) setRows: (int) r andColumns: (int) c;
- (void) setWindowClosing: (BOOL)closing;
- (EmacsToolbar *) toolbar;
- (void) deleteWorkingText;
-- (void) updateFrameSize: (BOOL) delay;
- (void) handleFS;
- (void) setFSValue: (int)value;
- (void) toggleFullScreen: (id) sender;
@@ -1084,18 +1075,6 @@ struct x_output
(FRAME_SCROLL_BAR_LINES (f) * FRAME_LINE_HEIGHT (f) \
- NS_SCROLL_BAR_HEIGHT (f)) : 0)
-/* Calculate system coordinates of the left and top of the parent
- window or, if there is no parent window, the screen. */
-#define NS_PARENT_WINDOW_LEFT_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.x : 0)
-#define NS_PARENT_WINDOW_TOP_POS(f) \
- (FRAME_PARENT_FRAME (f) != NULL \
- ? ([FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.origin.y \
- + [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window].frame.size.height \
- - FRAME_NS_TITLEBAR_HEIGHT (FRAME_PARENT_FRAME (f))) \
- : [[[NSScreen screens] objectAtIndex: 0] frame].size.height)
-
#define FRAME_NS_FONT_TABLE(f) (FRAME_DISPLAY_INFO (f)->font_table)
#define FRAME_FONTSET(f) ((f)->output_data.ns->fontset)
@@ -1210,6 +1189,7 @@ extern void syms_of_nsselect (void);
/* From nsimage.m, needed in image.c */
struct image;
+extern bool ns_can_use_native_image_api (Lisp_Object type);
extern void *ns_image_from_XBM (char *bits, int width, int height,
unsigned long fg, unsigned long bg);
extern void *ns_image_for_XPM (int width, int height, int depth);
diff --git a/src/nsterm.m b/src/nsterm.m
index 2f181ea..5eb4463 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -843,6 +843,32 @@ ns_menu_bar_height (NSScreen *screen)
}
+/* Get the frame rect, in system coordinates, of the parent window or,
+ if there is no parent window, the main screen. */
+static inline NSRect
+ns_parent_window_rect (struct frame *f)
+{
+ NSRect parentRect;
+
+ if (FRAME_PARENT_FRAME (f) != NULL)
+ {
+ EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
+ parentRect = [parentView convertRect:[parentView frame]
+ toView:nil];
+ parentRect = [[parentView window] convertRectToScreen:parentRect];
+ }
+ else
+ parentRect = [[[NSScreen screens] objectAtIndex:0] frame];
+
+ return parentRect;
+}
+
+/* Calculate system coordinates of the left and top of the parent
+ window or, if there is no parent window, the main screen. */
+#define NS_PARENT_WINDOW_LEFT_POS(f) NSMinX (ns_parent_window_rect (f))
+#define NS_PARENT_WINDOW_TOP_POS(f) NSMaxY (ns_parent_window_rect (f))
+
+
static NSRect
ns_row_rect (struct window *w, struct glyph_row *row,
enum glyph_row_area area)
@@ -1118,10 +1144,25 @@ ns_update_begin (struct frame *f)
ns_updating_frame = f;
#ifdef NS_DRAW_TO_BUFFER
- [view focusOnDrawingBuffer];
-#else
- [view lockFocus];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
+ {
+#endif
+ [view focusOnDrawingBuffer];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
+
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ [view lockFocus];
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
#endif
+
}
@@ -1140,15 +1181,29 @@ ns_update_end (struct frame *f)
MOUSE_HL_INFO (f)->mouse_face_defer = 0;
#ifdef NS_DRAW_TO_BUFFER
- [NSGraphicsContext setCurrentContext:nil];
- [view setNeedsDisplay:YES];
-#else
- block_input ();
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
+ {
+#endif
+ [NSGraphicsContext setCurrentContext:nil];
+ [view setNeedsDisplay:YES];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
- [view unlockFocus];
- [[view window] flushWindow];
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ block_input ();
- unblock_input ();
+ [view unlockFocus];
+ [[view window] flushWindow];
+
+ unblock_input ();
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
#endif
ns_updating_frame = NULL;
}
@@ -1173,24 +1228,39 @@ ns_focus (struct frame *f, NSRect *r, int n)
}
if (f != ns_updating_frame)
-#ifdef NS_DRAW_TO_BUFFER
- [view focusOnDrawingBuffer];
-#else
{
- if (view != focus_view)
+#ifdef NS_DRAW_TO_BUFFER
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
{
- if (focus_view != NULL)
+#endif
+ [view focusOnDrawingBuffer];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
+
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if (view != focus_view)
{
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- }
+ if (focus_view != NULL)
+ {
+ [focus_view unlockFocus];
+ [[focus_view window] flushWindow];
+ }
- if (view)
- [view lockFocus];
- focus_view = view;
+ if (view)
+ [view lockFocus];
+ focus_view = view;
+ }
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
- }
#endif
+ }
+
/* clipping */
if (r)
@@ -1220,16 +1290,30 @@ ns_unfocus (struct frame *f)
}
#ifdef NS_DRAW_TO_BUFFER
- [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
-#else
- if (f != ns_updating_frame)
+ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([FRAME_NS_VIEW (f) wantsUpdateLayer])
+ {
+#endif
+ [FRAME_NS_VIEW (f) setNeedsDisplay:YES];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
{
- if (focus_view != NULL)
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
+
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if (f != ns_updating_frame)
{
- [focus_view unlockFocus];
- [[focus_view window] flushWindow];
- focus_view = NULL;
+ if (focus_view != NULL)
+ {
+ [focus_view unlockFocus];
+ [[focus_view window] flushWindow];
+ focus_view = NULL;
+ }
}
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
}
#endif
}
@@ -1741,61 +1825,64 @@ ns_set_offset (struct frame *f, int xoff, int yoff, int
change_grav)
--------------------------------------------------------------------------
*/
{
NSView *view = FRAME_NS_VIEW (f);
- NSScreen *screen = [[view window] screen];
+ NSRect windowFrame = [[view window] frame];
+ NSPoint topLeft;
NSTRACE ("ns_set_offset");
block_input ();
- f->left_pos = xoff;
- f->top_pos = yoff;
+ if (FRAME_PARENT_FRAME (f))
+ {
+ /* Convert the parent frame's view rectangle into screen
+ coords. */
+ EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f));
+ NSRect parentRect = [parentView convertRect:[parentView frame]
+ toView:nil];
+ parentRect = [[parentView window] convertRectToScreen:parentRect];
+
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (parentRect) - NSWidth (windowFrame) + xoff;
+ else
+ topLeft.x = NSMinX (parentRect) + xoff;
- if (view != nil)
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (parentRect) + NSHeight (windowFrame) - yoff;
+ else
+ topLeft.y = NSMaxY (parentRect) - yoff;
+ }
+ else
{
- if (FRAME_PARENT_FRAME (f) == NULL && screen)
- {
- f->left_pos = f->size_hint_flags & XNegative
- ? [screen visibleFrame].size.width + f->left_pos -
FRAME_PIXEL_WIDTH (f)
- : f->left_pos;
- /* We use visibleFrame here to take menu bar into account.
- Ideally we should also adjust left/top with visibleFrame.origin.
*/
-
- f->top_pos = f->size_hint_flags & YNegative
- ? ([screen visibleFrame].size.height + f->top_pos
- - FRAME_PIXEL_HEIGHT (f) - FRAME_NS_TITLEBAR_HEIGHT (f)
- - FRAME_TOOLBAR_HEIGHT (f))
- : f->top_pos;
-#ifdef NS_IMPL_GNUSTEP
- if (f->left_pos < 100)
- f->left_pos = 100; /* don't overlap menu */
-#endif
- }
- else if (FRAME_PARENT_FRAME (f) != NULL)
- {
- struct frame *parent = FRAME_PARENT_FRAME (f);
+ /* If there is no parent frame then just convert to screen
+ coordinates, UNLESS we have negative values, in which case I
+ think it's best to position from the bottom and right of the
+ current screen rather than the main screen or whole
+ display. */
+ NSRect screenFrame = [[[view window] screen] frame];
- /* On X negative values for child frames always result in
- positioning relative to the bottom right corner of the
- parent frame. */
- if (f->left_pos < 0)
- f->left_pos = FRAME_PIXEL_WIDTH (parent) - FRAME_PIXEL_WIDTH (f) +
f->left_pos;
+ if (f->size_hint_flags & XNegative)
+ topLeft.x = NSMaxX (screenFrame) - NSWidth (windowFrame) + xoff;
+ else
+ topLeft.x = xoff;
- if (f->top_pos < 0)
- f->top_pos = FRAME_PIXEL_HEIGHT (parent) + FRAME_TOOLBAR_HEIGHT
(parent)
- - FRAME_PIXEL_HEIGHT (f) + f->top_pos;
- }
+ if (f->size_hint_flags & YNegative)
+ topLeft.y = NSMinY (screenFrame) + NSHeight (windowFrame) - yoff;
+ else
+ topLeft.y = NSMaxY ([[[NSScreen screens] objectAtIndex:0] frame]) -
yoff;
- /* Constrain the setFrameTopLeftPoint so we don't move behind the
- menu bar. */
- NSPoint pt = NSMakePoint (SCREENMAXBOUND (f->left_pos
- + NS_PARENT_WINDOW_LEFT_POS
(f)),
- SCREENMAXBOUND (NS_PARENT_WINDOW_TOP_POS (f)
- - f->top_pos));
- NSTRACE_POINT ("setFrameTopLeftPoint", pt);
- [[view window] setFrameTopLeftPoint: pt];
- f->size_hint_flags &= ~(XNegative|YNegative);
+#ifdef NS_IMPL_GNUSTEP
+ /* Don't overlap the menu.
+
+ FIXME: Surely there's a better way than just hardcoding 100
+ in here? */
+ topLeft.x = 100;
+#endif
}
+ NSTRACE_POINT ("setFrameTopLeftPoint", topLeft);
+ [[view window] setFrameTopLeftPoint:topLeft];
+ f->size_hint_flags &= ~(XNegative|YNegative);
+
unblock_input ();
}
@@ -1862,9 +1949,16 @@ ns_set_window_size (struct frame *f,
make_fixnum (FRAME_NS_TITLEBAR_HEIGHT (f)),
make_fixnum (FRAME_TOOLBAR_HEIGHT (f))));
- [window setFrame: wr display: YES];
+ /* Usually it seems safe to delay changing the frame size, but when a
+ series of actions are taken with no redisplay between them then we
+ can end up using old values so don't delay here. */
+ change_frame_size (f,
+ FRAME_PIXEL_TO_TEXT_WIDTH (f, pixelwidth),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixelheight),
+ 0, NO, 0, 1);
+
+ [window setFrame:wr display:NO];
- [view updateFrameSize: NO];
unblock_input ();
}
@@ -1913,7 +2007,6 @@ ns_set_undecorated (struct frame *f, Lisp_Object
new_value, Lisp_Object old_valu
so some key presses (TAB) are swallowed by the system. */
[window makeFirstResponder: view];
- [view updateFrameSize: NO];
unblock_input ();
}
}
@@ -5026,9 +5119,6 @@ ns_judge_scroll_bars (struct frame *f)
if ([view judge])
removed = YES;
}
-
- if (removed)
- [eview updateFrameSize: NO];
}
/* ==========================================================================
@@ -6215,6 +6305,17 @@ not_in_argv (NSString *arg)
- (void)dealloc
{
NSTRACE ("[EmacsView dealloc]");
+
+ /* Clear the view resize notification. */
+ [[NSNotificationCenter defaultCenter]
+ removeObserver:self
+ name:NSViewFrameDidChangeNotification
+ object:nil];
+
+#ifdef NS_DRAW_TO_BUFFER
+ CGContextRelease (drawingBuffer);
+#endif
+
[toolbar release];
if (fs_state == FULLSCREEN_BOTH)
[nonfs_window release];
@@ -7056,108 +7157,12 @@ not_in_argv (NSString *arg)
return NO;
}
-- (void) updateFrameSize: (BOOL) delay
-{
- NSWindow *window = [self window];
- NSRect wr = [window frame];
- int extra = 0;
- int oldc = cols, oldr = rows;
- int oldw = FRAME_PIXEL_WIDTH (emacsframe);
- int oldh = FRAME_PIXEL_HEIGHT (emacsframe);
- int neww, newh;
-
- NSTRACE ("[EmacsView updateFrameSize:]");
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
- NSTRACE_RECT ("Original frame", wr);
- NSTRACE_MSG ("Original columns: %d", cols);
- NSTRACE_MSG ("Original rows: %d", rows);
-
- if (! [self isFullscreen])
- {
- int toolbar_height;
-#ifdef NS_IMPL_GNUSTEP
- // GNUstep does not always update the tool bar height. Force it.
- if (toolbar && [toolbar isVisible])
- update_frame_tool_bar (emacsframe);
-#endif
-
- toolbar_height = FRAME_TOOLBAR_HEIGHT (emacsframe);
- if (toolbar_height < 0)
- toolbar_height = 35;
-
- extra = FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
- + toolbar_height;
- }
-
- if (wait_for_tool_bar)
- {
- /* The toolbar height is always 0 in fullscreen and undecorated
- frames, so don't wait for it to become available. */
- if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0
- && FRAME_UNDECORATED (emacsframe) == false
- && ! [self isFullscreen])
- {
- NSTRACE_MSG ("Waiting for toolbar");
- return;
- }
- wait_for_tool_bar = NO;
- }
-
- neww = (int)wr.size.width - emacsframe->border_width;
- newh = (int)wr.size.height - extra;
-
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
- NSTRACE_MSG ("FRAME_TOOLBAR_HEIGHT: %d", FRAME_TOOLBAR_HEIGHT (emacsframe));
- NSTRACE_MSG ("FRAME_NS_TITLEBAR_HEIGHT: %d", FRAME_NS_TITLEBAR_HEIGHT
(emacsframe));
-
- cols = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (emacsframe, neww);
- rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (emacsframe, newh);
-
- if (cols < MINWIDTH)
- cols = MINWIDTH;
-
- if (rows < MINHEIGHT)
- rows = MINHEIGHT;
-
- NSTRACE_MSG ("New columns: %d", cols);
- NSTRACE_MSG ("New rows: %d", rows);
-
- if (oldr != rows || oldc != cols || neww != oldw || newh != oldh)
- {
- NSView *view = FRAME_NS_VIEW (emacsframe);
-
- change_frame_size (emacsframe,
- FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww),
- FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
- 0, delay, 0, 1);
- SET_FRAME_GARBAGED (emacsframe);
- cancel_mouse_face (emacsframe);
-
- /* The next two lines set the frame to the same size as we've
- already set above. We need to do this when we switch back
- from non-native fullscreen, in other circumstances it appears
- to be a noop. (bug#28872) */
- wr = NSMakeRect (0, 0, neww, newh);
- [view setFrame: wr];
-#ifdef NS_DRAW_TO_BUFFER
- [self createDrawingBuffer];
-#endif
-
- // To do: consider using [NSNotificationCenter postNotificationName:].
- [self windowDidMove: // Update top/left.
- [NSNotification notificationWithName:NSWindowDidMoveNotification
- object:[view window]]];
- }
- else
- {
- NSTRACE_MSG ("No change");
- }
-}
- (NSSize)windowWillResize: (NSWindow *)sender toSize: (NSSize)frameSize
/* Normalize frame to gridded text size. */
{
int extra = 0;
+ int cols, rows;
NSTRACE ("[EmacsView windowWillResize:toSize: " NSTRACE_FMT_SIZE "]",
NSTRACE_ARG_SIZE (frameSize));
@@ -7294,11 +7299,6 @@ not_in_argv (NSString *arg)
sz = [self windowWillResize: theWindow toSize: sz];
#endif /* NS_IMPL_GNUSTEP */
- if (cols > 0 && rows > 0)
- {
- [self updateFrameSize: YES];
- }
-
ns_send_appdefined (-1);
}
@@ -7319,6 +7319,64 @@ not_in_argv (NSString *arg)
#endif /* NS_IMPL_COCOA */
+- (void)viewDidResize:(NSNotification *)notification
+{
+ NSRect frame = [self frame];
+ int oldw, oldh, neww, newh;
+
+ if (! FRAME_LIVE_P (emacsframe))
+ return;
+
+#ifdef NS_DRAW_TO_BUFFER
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([self wantsUpdateLayer])
+ {
+#endif
+ CGFloat scale = [[self window] backingScaleFactor];
+ oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale;
+ oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale;
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ oldw = FRAME_PIXEL_WIDTH (emacsframe);
+ oldh = FRAME_PIXEL_HEIGHT (emacsframe);
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+#endif
+
+ neww = (int)NSWidth (frame);
+ newh = (int)NSHeight (frame);
+
+ NSTRACE ("[EmacsView viewDidResize]");
+
+ /* Don't want to do anything when the view size hasn't changed. */
+ if ((oldh == newh && oldw == neww))
+ {
+ NSTRACE_MSG ("No change");
+ return;
+ }
+
+ NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
+ NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
+
+ change_frame_size (emacsframe,
+ FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww),
+ FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
+ 0, YES, 0, 1);
+
+#ifdef NS_DRAW_TO_BUFFER
+ [self createDrawingBuffer];
+#endif
+ SET_FRAME_GARBAGED (emacsframe);
+ cancel_mouse_face (emacsframe);
+}
+
+
- (void)windowDidBecomeKey: (NSNotification *)notification
/* cf. x_detect_focus_change(), x_focus_changed(), x_new_focus_frame() */
{
@@ -7480,10 +7538,6 @@ not_in_argv (NSString *arg)
maximizing_resize = NO;
#endif
-#ifdef NS_DRAW_TO_BUFFER
- [self createDrawingBuffer];
-#endif
-
win = [[EmacsWindow alloc]
initWithContentRect: r
styleMask: (FRAME_UNDECORATED (f)
@@ -7589,6 +7643,17 @@ not_in_argv (NSString *arg)
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
+#ifdef NS_DRAW_TO_BUFFER
+ [self createDrawingBuffer];
+#endif
+
+ /* Set up view resize notifications. */
+ [self setPostsFrameChangedNotifications:YES];
+ [[NSNotificationCenter defaultCenter]
+ addObserver:self
+ selector:@selector (viewDidResize:)
+ name:NSViewFrameDidChangeNotification object:nil];
+
/* macOS Sierra automatically enables tabbed windows. We can't
allow this to be enabled until it's available on a Free system.
Currently it only happens by accident and is buggy anyway. */
@@ -7618,9 +7683,8 @@ not_in_argv (NSString *arg)
return;
if (screen != nil)
{
- emacsframe->left_pos = r.origin.x - NS_PARENT_WINDOW_LEFT_POS
(emacsframe);
- emacsframe->top_pos =
- NS_PARENT_WINDOW_TOP_POS (emacsframe) - (r.origin.y + r.size.height);
+ emacsframe->left_pos = NSMinX (r) - NS_PARENT_WINDOW_LEFT_POS
(emacsframe);
+ emacsframe->top_pos = NS_PARENT_WINDOW_TOP_POS (emacsframe) - NSMaxY (r);
// FIXME: after event part below didExitFullScreen is not received
// if (emacs_event)
@@ -7919,7 +7983,6 @@ not_in_argv (NSString *arg)
{
[toolbar setVisible:YES];
update_frame_tool_bar (emacsframe);
- [self updateFrameSize:YES];
[[self window] display];
}
else
@@ -8132,11 +8195,11 @@ not_in_argv (NSString *arg)
// send notifications.
[self windowWillExitFullScreen];
- [fw setFrame: [w frame] display:YES animate:ns_use_fullscreen_animation];
+ [fw setFrame:[[w contentView] frame]
+ display:YES animate:ns_use_fullscreen_animation];
[fw close];
[w makeKeyAndOrderFront:NSApp];
[self windowDidExitFullScreen];
- [self updateFrameSize:YES];
}
}
@@ -8315,6 +8378,9 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView createDrawingBuffer]");
+ if (! [self wantsUpdateLayer])
+ return;
+
NSGraphicsContext *screen;
CGColorSpaceRef colorSpace = [[[self window] colorSpace] CGColorSpace];
CGFloat scale = [[self window] backingScaleFactor];
@@ -8350,6 +8416,9 @@ not_in_argv (NSString *arg)
{
NSTRACE ("EmacsView windowDidChangeBackingProperties:]");
+ if (! [self wantsUpdateLayer])
+ return;
+
CGFloat old = [[[notification userInfo]
objectForKey:@"NSBackingPropertyOldScaleFactorKey"]
doubleValue];
@@ -8373,41 +8442,56 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("Destination", dstRect);
#ifdef NS_DRAW_TO_BUFFER
- CGImageRef copy;
- NSRect frame = [self frame];
- NSAffineTransform *setOrigin = [NSAffineTransform transform];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if ([self wantsUpdateLayer])
+ {
+#endif
+ CGImageRef copy;
+ NSRect frame = [self frame];
+ NSAffineTransform *setOrigin = [NSAffineTransform transform];
- [[NSGraphicsContext currentContext] saveGraphicsState];
+ [[NSGraphicsContext currentContext] saveGraphicsState];
- /* Set the clipping before messing with the buffer's
- orientation. */
- NSRectClip (dstRect);
+ /* Set the clipping before messing with the buffer's
+ orientation. */
+ NSRectClip (dstRect);
- /* Unflip the buffer as the copied image will be unflipped, and
- offset the top left so when we draw back into the buffer the
- correct part of the image is drawn. */
- CGContextScaleCTM(drawingBuffer, 1, -1);
- CGContextTranslateCTM(drawingBuffer,
- NSMinX (dstRect) - NSMinX (srcRect),
- -NSHeight (frame) - (NSMinY (dstRect) - NSMinY
(srcRect)));
+ /* Unflip the buffer as the copied image will be unflipped, and
+ offset the top left so when we draw back into the buffer the
+ correct part of the image is drawn. */
+ CGContextScaleCTM(drawingBuffer, 1, -1);
+ CGContextTranslateCTM(drawingBuffer,
+ NSMinX (dstRect) - NSMinX (srcRect),
+ -NSHeight (frame) - (NSMinY (dstRect) - NSMinY
(srcRect)));
- /* Take a copy of the buffer and then draw it back to the buffer,
- limited by the clipping rectangle. */
- copy = CGBitmapContextCreateImage (drawingBuffer);
- CGContextDrawImage (drawingBuffer, frame, copy);
+ /* Take a copy of the buffer and then draw it back to the buffer,
+ limited by the clipping rectangle. */
+ copy = CGBitmapContextCreateImage (drawingBuffer);
+ CGContextDrawImage (drawingBuffer, frame, copy);
- CGImageRelease (copy);
+ CGImageRelease (copy);
- [[NSGraphicsContext currentContext] restoreGraphicsState];
- [self setNeedsDisplayInRect:dstRect];
-#else
- hide_bell(); // Ensure the bell image isn't scrolled.
+ [[NSGraphicsContext currentContext] restoreGraphicsState];
+ [self setNeedsDisplayInRect:dstRect];
- ns_focus (emacsframe, &dstRect, 1);
- [self scrollRect: srcRect
- by: NSMakeSize (dstRect.origin.x - srcRect.origin.x,
- dstRect.origin.y - srcRect.origin.y)];
- ns_unfocus (emacsframe);
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
+ else
+ {
+#endif
+#endif /* NS_DRAW_TO_BUFFER */
+
+#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ hide_bell(); // Ensure the bell image isn't scrolled.
+
+ ns_focus (emacsframe, &dstRect, 1);
+ [self scrollRect: srcRect
+ by: NSMakeSize (dstRect.origin.x - srcRect.origin.x,
+ dstRect.origin.y - srcRect.origin.y)];
+ ns_unfocus (emacsframe);
+#endif
+#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ }
#endif
}
@@ -8415,7 +8499,13 @@ not_in_argv (NSString *arg)
#ifdef NS_DRAW_TO_BUFFER
- (BOOL)wantsUpdateLayer
{
- return YES;
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
+ if (NSAppKitVersionNumber < 1671)
+ return NO;
+#endif
+
+ /* Running on macOS 10.14 or above. */
+ return YES;
}
@@ -8645,13 +8735,6 @@ not_in_argv (NSString *arg)
}
-- (void) setRows: (int) r andColumns: (int) c
-{
- NSTRACE ("[EmacsView setRows:%d andColumns:%d]", r, c);
- rows = r;
- cols = c;
-}
-
- (int) fullscreenState
{
return fs_state;
diff --git a/src/print.c b/src/print.c
index 9b8308a..c5f4bbe 100644
--- a/src/print.c
+++ b/src/print.c
@@ -368,8 +368,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t
size_byte,
int len;
for (ptrdiff_t i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int ch = string_char_and_length ((const unsigned char *) ptr + i,
+ &len);
printchar_to_stream (ch, stdout);
}
}
@@ -400,8 +400,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t
size_byte,
int len;
for (i = 0; i < size_byte; i += len)
{
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int ch = string_char_and_length ((const unsigned char *) ptr + i,
+ &len);
insert_char (ch);
}
}
@@ -426,9 +426,8 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t
size_byte,
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to
PRINTCHAR. */
- int len;
- int ch = STRING_CHAR_AND_LENGTH ((const unsigned char *) ptr + i,
- len);
+ int len, ch = (string_char_and_length
+ ((const unsigned char *) ptr + i, &len));
printchar (ch, printcharfun);
i += len;
}
@@ -510,8 +509,7 @@ print_string (Lisp_Object string, Lisp_Object printcharfun)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
- int len;
- int ch = STRING_CHAR_AND_LENGTH (SDATA (string) + i, len);
+ int len, ch = string_char_and_length (SDATA (string) + i, &len);
printchar (ch, printcharfun);
i += len;
}
@@ -1307,15 +1305,13 @@ print_check_string_charset_prop (INTERVAL interval,
Lisp_Object string)
}
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{
- int i, c;
ptrdiff_t charpos = interval->position;
ptrdiff_t bytepos = string_char_to_byte (string, charpos);
- Lisp_Object charset;
+ Lisp_Object charset = XCAR (XCDR (val));
- charset = XCAR (XCDR (val));
- for (i = 0; i < LENGTH (interval); i++)
+ for (ptrdiff_t i = 0; i < LENGTH (interval); i++)
{
- FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos);
+ int c = fetch_string_char_advance (string, &charpos, &bytepos);
if (! ASCII_CHAR_P (c)
&& ! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset))
{
@@ -1954,9 +1950,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to printchar.
*/
- int c;
-
- FETCH_STRING_CHAR_ADVANCE (c, obj, i, i_byte);
+ int c = fetch_string_char_advance (obj, &i, &i_byte);
maybe_quit ();
@@ -2047,8 +2041,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
{
/* Here, we must convert each multi-byte form to the
corresponding character code before handing it to PRINTCHAR. */
- int c;
- FETCH_STRING_CHAR_ADVANCE (c, name, i, i_byte);
+ int c = fetch_string_char_advance (name, &i, &i_byte);
maybe_quit ();
if (escapeflag)
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 0ae004e..ba7f3ce 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -58,7 +58,7 @@
#define RE_STRING_CHAR(p, multibyte) \
(multibyte ? STRING_CHAR (p) : *(p))
#define RE_STRING_CHAR_AND_LENGTH(p, len, multibyte) \
- (multibyte ? STRING_CHAR_AND_LENGTH (p, len) : ((len) = 1, *(p)))
+ (multibyte ? string_char_and_length (p, &(len)) : ((len) = 1, *(p)))
#define RE_CHAR_TO_MULTIBYTE(c) UNIBYTE_TO_CHAR (c)
@@ -89,7 +89,7 @@
#define GET_CHAR_AFTER(c, p, len) \
do { \
if (target_multibyte) \
- (c) = STRING_CHAR_AND_LENGTH (p, len); \
+ (c) = string_char_and_length (p, &(len)); \
else \
{ \
(c) = *p; \
@@ -3167,10 +3167,6 @@ re_search (struct re_pattern_buffer *bufp, const char
*string, ptrdiff_t size,
regs, size);
}
-/* Head address of virtual concatenation of string. */
-#define HEAD_ADDR_VSTRING(P) \
- (((P) >= size1 ? string2 : string1))
-
/* Address of POS in the concatenation of virtual string. */
#define POS_ADDR_VSTRING(POS) \
(((POS) >= size1 ? string2 - size1 : string1) + (POS))
@@ -3300,7 +3296,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char
*str1, ptrdiff_t size1,
{
int buf_charlen;
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
buf_ch = RE_TRANSLATE (translate, buf_ch);
if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
@@ -3330,7 +3326,7 @@ re_search_2 (struct re_pattern_buffer *bufp, const char
*str1, ptrdiff_t size1,
{
int buf_charlen;
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
if (fastmap[CHAR_LEADING_CODE (buf_ch)])
break;
range -= buf_charlen;
@@ -3413,16 +3409,12 @@ re_search_2 (struct re_pattern_buffer *bufp, const char
*str1, ptrdiff_t size1,
if (multibyte)
{
re_char *p = POS_ADDR_VSTRING (startpos) + 1;
- re_char *p0 = p;
- re_char *phead = HEAD_ADDR_VSTRING (startpos);
+ int len = raw_prev_char_len (p);
- /* Find the head of multibyte form. */
- PREV_CHAR_BOUNDARY (p, phead);
- range += p0 - 1 - p;
+ range += len - 1;
if (range > 0)
break;
-
- startpos -= p0 - 1 - p;
+ startpos -= len - 1;
}
}
}
@@ -3856,6 +3848,12 @@ re_match_2 (struct re_pattern_buffer *bufp,
return result;
}
+static void
+unwind_re_match (void *ptr)
+{
+ struct buffer *b = (struct buffer *) ptr;
+ b->text->inhibit_shrinking = 0;
+}
/* This is a separate function so that we can force an alloca cleanup
afterwards. */
@@ -3952,6 +3950,21 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
INIT_FAIL_STACK ();
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ /* Prevent shrinking and relocation of buffer text if GC happens
+ while we are inside this function. The calls to
+ UPDATE_SYNTAX_TABLE_* macros can call Lisp (via
+ `internal--syntax-propertize`); these calls are careful to defend against
+ buffer modifications, but even with no modifications, the buffer text may
+ be relocated during GC by `compact_buffer` which would invalidate
+ our C pointers to buffer text. */
+ if (!current_buffer->text->inhibit_shrinking)
+ {
+ record_unwind_protect_ptr (unwind_re_match, current_buffer);
+ current_buffer->text->inhibit_shrinking = 1;
+ }
+
/* Do not bother to initialize all the register variables if there are
no groups in the pattern, as it takes a fair amount of time. If
there are groups, we include space for register 0 (the whole
@@ -3968,6 +3981,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
/* The starting position is bogus. */
if (pos < 0 || pos > size1 + size2)
{
+ unbind_to (count, Qnil);
SAFE_FREE ();
return -1;
}
@@ -4182,6 +4196,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
DEBUG_PRINT ("Returning %td from re_match_2.\n", dcnt);
+ unbind_to (count, Qnil);
SAFE_FREE ();
return dcnt;
}
@@ -4218,13 +4233,13 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
PREFETCH ();
if (multibyte)
- pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen);
+ pat_ch = string_char_and_length (p, &pat_charlen);
else
{
pat_ch = RE_CHAR_TO_MULTIBYTE (*p);
pat_charlen = 1;
}
- buf_ch = STRING_CHAR_AND_LENGTH (d, buf_charlen);
+ buf_ch = string_char_and_length (d, &buf_charlen);
if (TRANSLATE (buf_ch) != pat_ch)
{
@@ -4246,7 +4261,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
PREFETCH ();
if (multibyte)
{
- pat_ch = STRING_CHAR_AND_LENGTH (p, pat_charlen);
+ pat_ch = string_char_and_length (p, &pat_charlen);
pat_ch = RE_CHAR_TO_UNIBYTE (pat_ch);
}
else
@@ -5028,6 +5043,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
if (best_regs_set)
goto restore_best_regs;
+ unbind_to (count, Qnil);
SAFE_FREE ();
return -1; /* Failure to match. */
diff --git a/src/search.c b/src/search.c
index 08b57c5..567270a 100644
--- a/src/search.c
+++ b/src/search.c
@@ -994,7 +994,7 @@ find_before_next_newline (ptrdiff_t from, ptrdiff_t to,
if (counted == cnt)
{
if (bytepos)
- DEC_BOTH (pos, *bytepos);
+ dec_both (&pos, &*bytepos);
else
pos--;
}
@@ -1353,8 +1353,8 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos,
while (--len >= 0)
{
unsigned char str_base[MAX_MULTIBYTE_LENGTH], *str;
- int c, translated, inverse;
- int in_charlen, charlen;
+ int translated, inverse;
+ int charlen;
/* If we got here and the RE flag is set, it's because we're
dealing with a regexp known to be trivial, so the backslash
@@ -1367,7 +1367,7 @@ search_buffer_non_re (Lisp_Object string, ptrdiff_t pos,
base_pat++;
}
- c = STRING_CHAR_AND_LENGTH (base_pat, in_charlen);
+ int in_charlen, c = string_char_and_length (base_pat, &in_charlen);
if (NILP (trt))
{
@@ -1550,12 +1550,10 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (this_len > 0)
{
- int charlen, buf_charlen;
- int pat_ch, buf_ch;
-
- pat_ch = STRING_CHAR_AND_LENGTH (p, charlen);
- buf_ch = STRING_CHAR_AND_LENGTH (BYTE_POS_ADDR (this_pos_byte),
- buf_charlen);
+ int charlen, pat_ch = string_char_and_length (p, &charlen);
+ int buf_charlen, buf_ch
+ = string_char_and_length (BYTE_POS_ADDR (this_pos_byte),
+ &buf_charlen);
TRANSLATE (buf_ch, trt, buf_ch);
if (buf_ch != pat_ch)
@@ -1576,7 +1574,7 @@ simple_search (EMACS_INT n, unsigned char *pat,
break;
}
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
}
n--;
@@ -1638,8 +1636,8 @@ simple_search (EMACS_INT n, unsigned char *pat,
{
int pat_ch, buf_ch;
- DEC_BOTH (this_pos, this_pos_byte);
- PREV_CHAR_BOUNDARY (p, pat);
+ dec_both (&this_pos, &this_pos_byte);
+ p -= raw_prev_char_len (p);
pat_ch = STRING_CHAR (p);
buf_ch = STRING_CHAR (BYTE_POS_ADDR (this_pos_byte));
TRANSLATE (buf_ch, trt, buf_ch);
@@ -1658,7 +1656,7 @@ simple_search (EMACS_INT n, unsigned char *pat,
break;
}
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
}
n++;
@@ -2437,10 +2435,11 @@ since only regular expressions have distinguished
subexpressions. */)
if (NILP (string))
{
c = FETCH_CHAR_AS_MULTIBYTE (pos_byte);
- INC_BOTH (pos, pos_byte);
+ inc_both (&pos, &pos_byte);
}
else
- FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, pos, pos_byte);
+ c = fetch_string_char_as_multibyte_advance (string,
+ &pos, &pos_byte);
if (lowercasep (c))
{
@@ -2513,11 +2512,11 @@ since only regular expressions have distinguished
subexpressions. */)
ptrdiff_t subend = 0;
bool delbackslash = 0;
- FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance (newtext, &pos, &pos_byte);
if (c == '\\')
{
- FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance (newtext, &pos, &pos_byte);
if (c == '&')
{
@@ -2625,7 +2624,8 @@ since only regular expressions have distinguished
subexpressions. */)
if (str_multibyte)
{
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext, pos, pos_byte);
+ c = fetch_string_char_advance_no_check (newtext,
+ &pos, &pos_byte);
if (!buf_multibyte)
c = CHAR_TO_BYTE8 (c);
}
@@ -2634,7 +2634,7 @@ since only regular expressions have distinguished
subexpressions. */)
/* Note that we don't have to increment POS. */
c = SREF (newtext, pos_byte++);
if (buf_multibyte)
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
}
/* Either set ADD_STUFF and ADD_LEN to the text to put in SUBSTED,
@@ -2647,8 +2647,8 @@ since only regular expressions have distinguished
subexpressions. */)
if (str_multibyte)
{
- FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, newtext,
- pos, pos_byte);
+ c = fetch_string_char_advance_no_check (newtext,
+ &pos, &pos_byte);
if (!buf_multibyte && !ASCII_CHAR_P (c))
c = CHAR_TO_BYTE8 (c);
}
@@ -2656,7 +2656,7 @@ since only regular expressions have distinguished
subexpressions. */)
{
c = SREF (newtext, pos_byte++);
if (buf_multibyte)
- MAKE_CHAR_MULTIBYTE (c);
+ c = make_char_multibyte (c);
}
if (c == '&')
diff --git a/src/syntax.c b/src/syntax.c
index e24b98d..a03202d 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -480,10 +480,10 @@ parse_sexp_propertize (ptrdiff_t charpos)
safe_call1 (Qinternal__syntax_propertize,
make_fixnum (min (zv, 1 + charpos)));
if (modiffs != CHARS_MODIFF)
- error ("parse-sexp-propertize-function modified the buffer!");
+ error ("internal--syntax-propertize modified the buffer!");
if (syntax_propertize__done <= charpos
&& syntax_propertize__done < zv)
- error ("parse-sexp-propertize-function did not move"
+ error ("internal--syntax-propertize did not move"
" syntax-propertize--done");
SETUP_SYNTAX_TABLE (charpos, 1);
}
@@ -535,7 +535,7 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
while (charpos > beg)
{
int c;
- DEC_BOTH (charpos, bytepos);
+ dec_both (&charpos, &bytepos);
UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
c = FETCH_CHAR_AS_MULTIBYTE (bytepos);
@@ -556,11 +556,9 @@ char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
static ptrdiff_t
dec_bytepos (ptrdiff_t bytepos)
{
- if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- return bytepos - 1;
-
- DEC_POS (bytepos);
- return bytepos;
+ return (bytepos
+ - (!NILP (BVAR (current_buffer, enable_multibyte_characters))
+ ? prev_char_len (bytepos) : 1));
}
/* Return a defun-start position before POS and not too far before.
@@ -667,7 +665,7 @@ prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte)
int c;
bool val;
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (pos);
c = FETCH_CHAR (pos_byte);
val = SYNTAX_COMEND_FIRST (c);
@@ -738,7 +736,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
bool com2start, com2end, comstart;
/* Move back and examine a character. */
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
prev_syntax = syntax;
@@ -773,7 +771,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
{
ptrdiff_t next = from, next_byte = from_byte;
int next_c, next_syntax;
- DEC_BOTH (next, next_byte);
+ dec_both (&next, &next_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (next);
next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte);
next_syntax = SYNTAX_WITH_FLAGS (next_c);
@@ -1150,8 +1148,7 @@ the value of a `syntax-table' text property. */)
if (*p)
{
- int len;
- int character = STRING_CHAR_AND_LENGTH (p, len);
+ int len, character = string_char_and_length (p, &len);
XSETINT (match, character);
if (XFIXNAT (match) == ' ')
match = Qnil;
@@ -1444,7 +1441,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
int ch0, ch1;
Lisp_Object func, pos;
- SETUP_SYNTAX_TABLE (from, count);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
while (count > 0)
{
@@ -1455,7 +1452,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
UPDATE_SYNTAX_TABLE_FORWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (words_include_escapes
&& (code == Sescape || code == Scharquote))
break;
@@ -1488,7 +1485,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
|| (code != Sescape && code != Scharquote)))
|| word_boundary_p (ch0, ch1))
break;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
ch0 = ch1;
rarely_quit (from);
}
@@ -1501,7 +1498,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
{
if (from == beg)
return 0;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch1);
@@ -1530,7 +1527,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
{
if (from == beg)
break;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
code = SYNTAX (ch0);
@@ -1539,7 +1536,7 @@ scan_words (ptrdiff_t from, EMACS_INT count)
|| (code != Sescape && code != Scharquote)))
|| word_boundary_p (ch0, ch1))
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
break;
}
ch1 = ch0;
@@ -1818,7 +1815,7 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
leading_code = str[i_byte];
}
- c = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c = string_char_and_length (str + i_byte, &len);
i_byte += len;
@@ -1834,14 +1831,14 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
/* Get the end of the range. */
leading_code2 = str[i_byte];
- c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c2 = string_char_and_length (str + i_byte, &len);
i_byte += len;
if (c2 == '\\'
&& i_byte < size_byte)
{
leading_code2 = str[i_byte];
- c2 = STRING_CHAR_AND_LENGTH (str + i_byte, len);
+ c2 = string_char_and_length (str + i_byte, &len);
i_byte += len;
}
@@ -1953,7 +1950,7 @@ skip_chars (bool forwardp, Lisp_Object string,
Lisp_Object lim,
p = GAP_END_ADDR;
stop = endp;
}
- c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ c = string_char_and_length (p, &nbytes);
if (! NILP (iso_classes) && in_classes (c, iso_classes))
{
if (negate)
@@ -2175,7 +2172,7 @@ skip_syntaxes (bool forwardp, Lisp_Object string,
Lisp_Object lim)
stop = endp;
}
if (multibyte)
- c = STRING_CHAR_AND_LENGTH (p, nbytes);
+ c = string_char_and_length (p, &nbytes);
else
c = *p, nbytes = 1;
if (! fastmap[SYNTAX (c)])
@@ -2357,7 +2354,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
/* We have encountered a nested comment of the same style
as the comment sequence which began this comment section. */
nesting++;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
forw_incomment:
@@ -2378,7 +2375,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
break;
else
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
}
@@ -2395,7 +2392,7 @@ forw_comment (ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t stop,
as the comment sequence which began this comment section. */
{
syntax = Smax; /* So that "#|#" isn't also a comment ender. */
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
nesting++;
}
@@ -2437,7 +2434,7 @@ between them, return t; otherwise return nil. */)
from = PT;
from_byte = PT_BYTE;
- SETUP_SYNTAX_TABLE (from, count1);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count1, PTRDIFF_MAX));
while (count1 > 0)
{
do
@@ -2456,7 +2453,7 @@ between them, return t; otherwise return nil. */)
comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax);
comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
&& (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
@@ -2471,7 +2468,7 @@ between them, return t; otherwise return nil. */)
code = Scomment;
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
rarely_quit (++quit_count);
@@ -2482,7 +2479,7 @@ between them, return t; otherwise return nil. */)
comstyle = ST_COMMENT_STYLE;
else if (code != Scomment)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2495,7 +2492,7 @@ between them, return t; otherwise return nil. */)
SET_PT_BOTH (from, from_byte);
return Qnil;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
/* We have skipped one comment. */
count1--;
@@ -2511,7 +2508,7 @@ between them, return t; otherwise return nil. */)
return Qnil;
}
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
/* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */
bool quoted = char_quoted (from, from_byte);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2529,7 +2526,7 @@ between them, return t; otherwise return nil. */)
/* We must record the comment style encountered so that
later, we can match only the proper comment begin
sequence of the same style. */
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
code = Sendcomment;
/* Calling char_quoted, above, set up global syntax position
at the new value of FROM. */
@@ -2547,7 +2544,7 @@ between them, return t; otherwise return nil. */)
while (1)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
if (SYNTAX (c) == Scomment_fence
@@ -2572,8 +2569,9 @@ between them, return t; otherwise return nil. */)
}
else if (code == Sendcomment)
{
- found = back_comment (from, from_byte, stop, comnested, comstyle,
- &out_charpos, &out_bytepos);
+ found = (!quoted || !Vcomment_end_can_be_escaped)
+ && back_comment (from, from_byte, stop, comnested, comstyle,
+ &out_charpos, &out_bytepos);
if (!found)
{
if (c == '\n')
@@ -2587,7 +2585,7 @@ between them, return t; otherwise return nil. */)
not-quite-endcomment. */
if (SYNTAX (c) != code)
/* It was a two-char Sendcomment. */
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
goto leave;
}
}
@@ -2601,7 +2599,7 @@ between them, return t; otherwise return nil. */)
else if (code != Swhitespace || quoted)
{
leave:
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
SET_PT_BOTH (from, from_byte);
return Qnil;
}
@@ -2626,7 +2624,7 @@ syntax_multibyte (int c, bool multibyte_symbol_p)
}
static Lisp_Object
-scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT depth, bool sexpflag)
+scan_lists (EMACS_INT from0, EMACS_INT count, EMACS_INT depth, bool sexpflag)
{
Lisp_Object val;
ptrdiff_t stop = count > 0 ? ZV : BEGV;
@@ -2639,7 +2637,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
int comstyle = 0; /* Style of comment encountered. */
bool comnested = 0; /* Whether the comment is nestable or not. */
ptrdiff_t temp_pos;
- EMACS_INT last_good = from;
+ EMACS_INT last_good = from0;
bool found;
ptrdiff_t from_byte;
ptrdiff_t out_bytepos, out_charpos;
@@ -2650,14 +2648,13 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if (depth > 0) min_depth = 0;
- if (from > ZV) from = ZV;
- if (from < BEGV) from = BEGV;
+ ptrdiff_t from = clip_to_bounds (BEGV, from0, ZV);
from_byte = CHAR_TO_BYTE (from);
maybe_quit ();
- SETUP_SYNTAX_TABLE (from, count);
+ SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
while (count > 0)
{
while (from < stop)
@@ -2675,7 +2672,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
prefix = SYNTAX_FLAGS_PREFIX (syntax);
if (depth == min_depth)
last_good = from;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
if (from < stop && comstart_first
&& (c = FETCH_CHAR_AS_MULTIBYTE (from_byte),
@@ -2691,7 +2688,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
code = Scomment;
comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
}
@@ -2704,7 +2701,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
case Scharquote:
if (from == stop)
goto lose;
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
/* Treat following character as a word constituent. */
FALLTHROUGH;
case Sword:
@@ -2720,7 +2717,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
{
case Scharquote:
case Sescape:
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (from == stop)
goto lose;
break;
@@ -2731,7 +2728,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
default:
goto done;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
rarely_quit (++quit_count);
}
goto done;
@@ -2753,7 +2750,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
goto done;
goto lose;
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_FORWARD (from);
break;
@@ -2762,7 +2759,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
break;
if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte))
{
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
}
if (mathexit)
{
@@ -2802,11 +2799,11 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
break;
if (c_code == Scharquote || c_code == Sescape)
- INC_BOTH (from, from_byte);
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
+ inc_both (&from, &from_byte);
rarely_quit (++quit_count);
}
- INC_BOTH (from, from_byte);
+ inc_both (&from, &from_byte);
if (!depth && sexpflag) goto done;
break;
default:
@@ -2831,7 +2828,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
while (from > stop)
{
rarely_quit (++quit_count);
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
int syntax = SYNTAX_WITH_FLAGS (c);
@@ -2850,7 +2847,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
later, we can match only the proper comment begin
sequence of the same style. */
int c2, other_syntax;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
code = Sendcomment;
c2 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
@@ -2864,7 +2861,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
if we decremented FROM in the if-statement above. */
if (code != Sendcomment && char_quoted (from, from_byte))
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
code = Sword;
}
else if (SYNTAX_FLAGS_PREFIX (syntax))
@@ -2881,11 +2878,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
after passing it. */
while (from > stop)
{
- temp_pos = from_byte;
- if (! NILP (BVAR (current_buffer,
enable_multibyte_characters)))
- DEC_POS (temp_pos);
- else
- temp_pos--;
+ temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
/* Don't allow comment-end to be quoted. */
@@ -2894,7 +2887,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
quoted = char_quoted (from - 1, temp_pos);
if (quoted)
{
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
temp_pos = dec_bytepos (temp_pos);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
}
@@ -2905,7 +2898,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
case Sword: case Ssymbol: case Squote: break;
default: goto done2;
}
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
rarely_quit (++quit_count);
}
goto done2;
@@ -2918,7 +2911,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
temp_pos = dec_bytepos (from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos))
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
}
if (mathexit)
{
@@ -2961,7 +2954,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
{
if (from == stop)
goto lose;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte))
{
@@ -2980,7 +2973,7 @@ scan_lists (EMACS_INT from, EMACS_INT count, EMACS_INT
depth, bool sexpflag)
{
if (from == stop)
goto lose;
- DEC_BOTH (from, from_byte);
+ dec_both (&from, &from_byte);
UPDATE_SYNTAX_TABLE_BACKWARD (from);
if (!char_quoted (from, from_byte))
{
@@ -3090,7 +3083,7 @@ the prefix syntax flag (p). */)
SETUP_SYNTAX_TABLE (pos, -1);
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
while (!char_quoted (pos, pos_byte)
/* Previous statement updates syntax table. */
@@ -3102,7 +3095,7 @@ the prefix syntax flag (p). */)
if (pos <= beg)
break;
- DEC_BOTH (pos, pos_byte);
+ dec_both (&pos, &pos_byte);
rarely_quit (pos);
}
@@ -3179,7 +3172,7 @@ scan_sexps_forward (struct lisp_parse_state *state,
prev_from = from;
prev_from_byte = from_byte;
if (from != BEGV)
- DEC_BOTH (prev_from, prev_from_byte);
+ dec_both (&prev_from, &prev_from_byte);
/* Use this macro instead of `from++'. */
#define INC_FROM \
@@ -3188,7 +3181,7 @@ do { prev_from = from; \
temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
prev_prev_from_syntax = prev_from_syntax; \
prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
- INC_BOTH (from, from_byte); \
+ inc_both (&from, &from_byte); \
if (from < end) \
UPDATE_SYNTAX_TABLE_FORWARD (from); \
} while (0)
diff --git a/src/sysdep.c b/src/sysdep.c
index 149d80f..86e7c20 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -4133,14 +4133,20 @@ str_collate (Lisp_Object s1, Lisp_Object s2,
len = SCHARS (s1); i = i_byte = 0;
SAFE_NALLOCA (p1, 1, len + 1);
while (i < len)
- FETCH_STRING_CHAR_ADVANCE (*(p1+i-1), s1, i, i_byte);
- *(p1+len) = 0;
+ {
+ wchar_t *p = &p1[i];
+ *p = fetch_string_char_advance (s1, &i, &i_byte);
+ }
+ p1[len] = 0;
len = SCHARS (s2); i = i_byte = 0;
SAFE_NALLOCA (p2, 1, len + 1);
while (i < len)
- FETCH_STRING_CHAR_ADVANCE (*(p2+i-1), s2, i, i_byte);
- *(p2+len) = 0;
+ {
+ wchar_t *p = &p2[i];
+ *p = fetch_string_char_advance (s2, &i, &i_byte);
+ }
+ p2[len] = 0;
if (STRINGP (locale))
{
diff --git a/src/w32.c b/src/w32.c
index 42c832a..0f69e65 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -2370,6 +2370,26 @@ srandom (int seed)
iz = rand () % RAND_MAX_Z;
}
+/* Emulate explicit_bzero. This is to avoid using the Gnulib version,
+ because it calls SecureZeroMemory at will, disregarding systems
+ older than Windows XP, which didn't have that function. We want to
+ avoid having that function as dependency in builds that need to
+ support systems older than Windows XP, otherwise Emacs will refuse
+ to start on those systems. */
+void
+explicit_bzero (void *buf, size_t len)
+{
+#if _WIN32_WINNT >= 0x0501
+ /* We are compiling for XP or newer, most probably with MinGW64.
+ We can use SecureZeroMemory. */
+ SecureZeroMemory (buf, len);
+#else
+ memset (buf, 0, len);
+ /* Compiler barrier. */
+ asm volatile ("" ::: "memory");
+#endif
+}
+
/* Return the maximum length in bytes of a multibyte character
sequence encoded in the current ANSI codepage. This is required to
correctly walk the encoded file names one character at a time. */
diff --git a/src/w32image.c b/src/w32image.c
index 0a2a55d..8d39a09 100644
--- a/src/w32image.c
+++ b/src/w32image.c
@@ -40,28 +40,47 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
-DEF_DLL_FN (GpStatus, GdiplusStartup,
- (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *));
-DEF_DLL_FN (VOID, GdiplusShutdown, (ULONG_PTR));
-DEF_DLL_FN (GpStatus, GdipGetPropertyItemSize,
- (GpImage *, PROPID, UINT *));
-DEF_DLL_FN (GpStatus, GdipGetPropertyItem,
- (GpImage *, PROPID, UINT, PropertyItem *));
-DEF_DLL_FN (GpStatus, GdipImageGetFrameDimensionsCount, (GpImage *, UINT *));
-DEF_DLL_FN (GpStatus, GdipImageGetFrameDimensionsList,
- (GpImage *, GUID *, UINT));
-DEF_DLL_FN (GpStatus, GdipImageGetFrameCount,
- (GpImage *, GDIPCONST GUID *, UINT *));
-DEF_DLL_FN (GpStatus, GdipImageSelectActiveFrame,
- (GpImage*, GDIPCONST GUID *, UINT));
-DEF_DLL_FN (GpStatus, GdipCreateBitmapFromFile, (WCHAR *, GpBitmap **));
-DEF_DLL_FN (GpStatus, GdipCreateBitmapFromStream, (IStream *, GpBitmap **));
-DEF_DLL_FN (IStream *, SHCreateMemStream, (const BYTE *pInit, UINT cbInit));
-DEF_DLL_FN (GpStatus, GdipCreateHBITMAPFromBitmap,
- (GpBitmap *, HBITMAP *, ARGB));
-DEF_DLL_FN (GpStatus, GdipDisposeImage, (GpImage *));
-DEF_DLL_FN (GpStatus, GdipGetImageHeight, (GpImage *, UINT *));
-DEF_DLL_FN (GpStatus, GdipGetImageWidth, (GpImage *, UINT *));
+typedef GpStatus (WINGDIPAPI *GdiplusStartup_Proc)
+ (ULONG_PTR *, GdiplusStartupInput *, GdiplusStartupOutput *);
+typedef VOID (WINGDIPAPI *GdiplusShutdown_Proc) (ULONG_PTR);
+typedef GpStatus (WINGDIPAPI *GdipGetPropertyItemSize_Proc)
+ (GpImage *, PROPID, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetPropertyItem_Proc)
+ (GpImage *, PROPID, UINT, PropertyItem *);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsCount_Proc)
+ (GpImage *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameDimensionsList_Proc)
+ (GpImage *, GUID *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipImageGetFrameCount_Proc)
+ (GpImage *, GDIPCONST GUID *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipImageSelectActiveFrame_Proc)
+ (GpImage*, GDIPCONST GUID *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromFile_Proc)
+ (WCHAR *, GpBitmap **);
+typedef GpStatus (WINGDIPAPI *GdipCreateBitmapFromStream_Proc)
+ (IStream *, GpBitmap **);
+typedef IStream * (WINAPI *SHCreateMemStream_Proc) (const BYTE *, UINT);
+typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc)
+ (GpBitmap *, HBITMAP *, ARGB);
+typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *);
+
+GdiplusStartup_Proc fn_GdiplusStartup;
+GdiplusShutdown_Proc fn_GdiplusShutdown;
+GdipGetPropertyItemSize_Proc fn_GdipGetPropertyItemSize;
+GdipGetPropertyItem_Proc fn_GdipGetPropertyItem;
+GdipImageGetFrameDimensionsCount_Proc fn_GdipImageGetFrameDimensionsCount;
+GdipImageGetFrameDimensionsList_Proc fn_GdipImageGetFrameDimensionsList;
+GdipImageGetFrameCount_Proc fn_GdipImageGetFrameCount;
+GdipImageSelectActiveFrame_Proc fn_GdipImageSelectActiveFrame;
+GdipCreateBitmapFromFile_Proc fn_GdipCreateBitmapFromFile;
+GdipCreateBitmapFromStream_Proc fn_GdipCreateBitmapFromStream;
+SHCreateMemStream_Proc fn_SHCreateMemStream;
+GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap;
+GdipDisposeImage_Proc fn_GdipDisposeImage;
+GdipGetImageHeight_Proc fn_GdipGetImageHeight;
+GdipGetImageWidth_Proc fn_GdipGetImageWidth;
static bool
gdiplus_init (void)
@@ -72,33 +91,73 @@ gdiplus_init (void)
&& (shlwapi_lib = w32_delayed_load (Qshlwapi))))
return false;
- LOAD_DLL_FN (gdiplus_lib, GdiplusStartup);
- LOAD_DLL_FN (gdiplus_lib, GdiplusShutdown);
- LOAD_DLL_FN (gdiplus_lib, GdipGetPropertyItemSize);
- LOAD_DLL_FN (gdiplus_lib, GdipGetPropertyItem);
- LOAD_DLL_FN (gdiplus_lib, GdipImageGetFrameDimensionsCount);
- LOAD_DLL_FN (gdiplus_lib, GdipImageGetFrameDimensionsList);
- LOAD_DLL_FN (gdiplus_lib, GdipImageGetFrameCount);
- LOAD_DLL_FN (gdiplus_lib, GdipImageSelectActiveFrame);
- LOAD_DLL_FN (gdiplus_lib, GdipCreateBitmapFromFile);
- LOAD_DLL_FN (gdiplus_lib, GdipCreateBitmapFromStream);
- LOAD_DLL_FN (gdiplus_lib, GdipCreateHBITMAPFromBitmap);
- LOAD_DLL_FN (gdiplus_lib, GdipDisposeImage);
- LOAD_DLL_FN (gdiplus_lib, GdipGetImageHeight);
- LOAD_DLL_FN (gdiplus_lib, GdipGetImageWidth);
+ fn_GdiplusStartup = (GdiplusStartup_Proc)
+ get_proc_addr (gdiplus_lib, "GdiplusStartup");
+ if (!fn_GdiplusStartup)
+ return false;
+ fn_GdiplusShutdown = (GdiplusShutdown_Proc)
+ get_proc_addr (gdiplus_lib, "GdiplusShutdown");
+ if (!fn_GdiplusShutdown)
+ return false;
+ fn_GdipGetPropertyItemSize = (GdipGetPropertyItemSize_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetPropertyItemSize");
+ if (!fn_GdipGetPropertyItemSize)
+ return false;
+ fn_GdipGetPropertyItem = (GdipGetPropertyItem_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetPropertyItem");
+ if (!fn_GdipGetPropertyItem)
+ return false;
+ fn_GdipImageGetFrameDimensionsCount = (GdipImageGetFrameDimensionsCount_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsCount");
+ if (!fn_GdipImageGetFrameDimensionsCount)
+ return false;
+ fn_GdipImageGetFrameDimensionsList = (GdipImageGetFrameDimensionsList_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameDimensionsList");
+ if (!fn_GdipImageGetFrameDimensionsList)
+ return false;
+ fn_GdipImageGetFrameCount = (GdipImageGetFrameCount_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageGetFrameCount");
+ if (!fn_GdipImageGetFrameCount)
+ return false;
+ fn_GdipImageSelectActiveFrame = (GdipImageSelectActiveFrame_Proc)
+ get_proc_addr (gdiplus_lib, "GdipImageSelectActiveFrame");
+ if (!fn_GdipImageSelectActiveFrame)
+ return false;
+ fn_GdipCreateBitmapFromFile = (GdipCreateBitmapFromFile_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromFile");
+ if (!fn_GdipCreateBitmapFromFile)
+ return false;
+ fn_GdipCreateBitmapFromStream = (GdipCreateBitmapFromStream_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateBitmapFromStream");
+ if (!fn_GdipCreateBitmapFromStream)
+ return false;
+ fn_GdipCreateHBITMAPFromBitmap = (GdipCreateHBITMAPFromBitmap_Proc)
+ get_proc_addr (gdiplus_lib, "GdipCreateHBITMAPFromBitmap");
+ if (!fn_GdipCreateHBITMAPFromBitmap)
+ return false;
+ fn_GdipDisposeImage = (GdipDisposeImage_Proc)
+ get_proc_addr (gdiplus_lib, "GdipDisposeImage");
+ if (!fn_GdipDisposeImage)
+ return false;
+ fn_GdipGetImageHeight = (GdipGetImageHeight_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetImageHeight");
+ if (!fn_GdipGetImageHeight)
+ return false;
+ fn_GdipGetImageWidth = (GdipGetImageWidth_Proc)
+ get_proc_addr (gdiplus_lib, "GdipGetImageWidth");
+ if (!fn_GdipGetImageWidth)
+ return false;
/* LOAD_DLL_FN (shlwapi_lib, SHCreateMemStream); */
/* The following terrible kludge is required to use native image API
on Windows before Vista, because SHCreateMemStream was not
exported by name in those versions, only by ordinal number. */
- fn_SHCreateMemStream =
- (W32_PFN_SHCreateMemStream) get_proc_addr (shlwapi_lib,
- "SHCreateMemStream");
+ fn_SHCreateMemStream = (SHCreateMemStream_Proc)
+ get_proc_addr (shlwapi_lib, "SHCreateMemStream");
if (!fn_SHCreateMemStream)
{
- fn_SHCreateMemStream =
- (W32_PFN_SHCreateMemStream) get_proc_addr (shlwapi_lib,
- MAKEINTRESOURCEA (12));
+ fn_SHCreateMemStream = (SHCreateMemStream_Proc)
+ get_proc_addr (shlwapi_lib, MAKEINTRESOURCEA (12));
if (!fn_SHCreateMemStream)
return false;
}
@@ -214,30 +273,37 @@ enum PropertyItem_type {
PI_LONG_PAIR = 10
};
-static unsigned long
+static double
decode_delay (PropertyItem *propertyItem, int frame)
{
enum PropertyItem_type type = propertyItem[0].type;
- unsigned long delay;
+ unsigned long udelay;
+ double retval;
switch (type)
{
case PI_BYTE:
case PI_BYTE_ANY:
- delay = ((unsigned char *)propertyItem[0].value)[frame];
+ udelay = ((unsigned char *)propertyItem[0].value)[frame];
+ retval = udelay;
break;
case PI_USHORT:
- delay = ((unsigned short *)propertyItem[0].value)[frame];
+ udelay = ((unsigned short *)propertyItem[0].value)[frame];
+ retval = udelay;
break;
case PI_ULONG:
case PI_LONG: /* delay should always be positive */
- delay = ((unsigned long *)propertyItem[0].value)[frame];
+ udelay = ((unsigned long *)propertyItem[0].value)[frame];
+ retval = udelay;
break;
default:
- emacs_abort ();
+ /* This negative value will cause the caller to disregard the
+ delay if we cannot determine it reliably. */
+ add_to_log ("Invalid or unknown propertyItem type in w32image.c");
+ retval = -1.0;
}
- return delay;
+ return retval;
}
static double
@@ -245,27 +311,33 @@ w32_frame_delay (GpBitmap *pBitmap, int frame)
{
UINT size;
PropertyItem *propertyItem;
- double delay = 0.0;
+ double delay = -1.0;
/* Assume that the image has a property item of type PropertyItemEquipMake.
- Get the size of that property item. */
- GdipGetPropertyItemSize (pBitmap, PropertyTagFrameDelay, &size);
+ Get the size of that property item. This can fail for multi-frame TIFF
+ images. */
+ GpStatus status = GdipGetPropertyItemSize (pBitmap, PropertyTagFrameDelay,
+ &size);
- /* Allocate a buffer to receive the property item. */
- propertyItem = malloc (size);
- if (propertyItem != NULL)
+ if (status == Ok)
{
- /* Get the property item. */
- GdipGetPropertyItem (pBitmap, PropertyTagFrameDelay, size, propertyItem);
- delay = decode_delay (propertyItem, frame);
- if (delay <= 0)
- {
- /* In GIF files, unfortunately, delay is only specified for the first
- frame. */
- delay = decode_delay (propertyItem, 0);
- }
- delay /= 100.0;
- free (propertyItem);
+ /* Allocate a buffer to receive the property item. */
+ propertyItem = malloc (size);
+ if (propertyItem != NULL)
+ {
+ /* Get the property item. */
+ GdipGetPropertyItem (pBitmap, PropertyTagFrameDelay, size,
+ propertyItem);
+ delay = decode_delay (propertyItem, frame);
+ if (delay <= 0)
+ {
+ /* In GIF files, unfortunately, delay is only specified
+ for the first frame. */
+ delay = decode_delay (propertyItem, 0);
+ }
+ delay /= 100.0;
+ free (propertyItem);
+ }
}
return delay;
}
@@ -280,7 +352,7 @@ w32_select_active_frame (GpBitmap *pBitmap, int frame, int
*nframes,
status = GdipImageGetFrameDimensionsCount (pBitmap, &count);
frameCount = *nframes = 0;
- *delay = 0.0;
+ *delay = -1.0;
if (count)
{
/* The following call will fill pDimensionIDs[0] with the
@@ -372,11 +444,9 @@ w32_load_image (struct frame *f, struct image *img,
{
if (nframes > 1)
metadata = Fcons (Qcount, Fcons (make_fixnum (nframes), metadata));
- if (delay)
+ if (delay >= 0)
metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata));
}
- else if (status == Win32Error) /* FIXME! */
- status = Ok;
}
if (status == Ok)
diff --git a/src/xdisp.c b/src/xdisp.c
index cce434e..01f2720 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1901,16 +1901,14 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int
*x, int *y,
/* Return the next character from STR. Return in *LEN the length of
- the character. This is like STRING_CHAR_AND_LENGTH but never
+ the character. This is like string_char_and_length but never
returns an invalid character. If we find one, we return a `?', but
with the length of the invalid character. */
static int
-string_char_and_length (const unsigned char *str, int *len)
+check_char_and_length (const unsigned char *str, int *len)
{
- int c;
-
- c = STRING_CHAR_AND_LENGTH (str, *len);
+ int c = string_char_and_length (str, len);
if (!CHAR_VALID_P (c))
/* We may not change the length here because other places in Emacs
don't use this function, i.e. they silently accept invalid
@@ -1933,11 +1931,10 @@ string_pos_nchars_ahead (struct text_pos pos,
Lisp_Object string, ptrdiff_t ncha
if (STRING_MULTIBYTE (string))
{
const unsigned char *p = SDATA (string) + BYTEPOS (pos);
- int len;
while (nchars--)
{
- string_char_and_length (p, &len);
+ int len = BYTES_BY_CHAR_HEAD (*p);
p += len;
CHARPOS (pos) += 1;
BYTEPOS (pos) += len;
@@ -1978,12 +1975,10 @@ c_string_pos (ptrdiff_t charpos, const char *s, bool
multibyte_p)
if (multibyte_p)
{
- int len;
-
SET_TEXT_POS (pos, 0, 0);
while (charpos--)
{
- string_char_and_length ((const unsigned char *) s, &len);
+ int len = BYTES_BY_CHAR_HEAD (*s);
s += len;
CHARPOS (pos) += 1;
BYTEPOS (pos) += len;
@@ -2007,12 +2002,11 @@ number_of_chars (const char *s, bool multibyte_p)
if (multibyte_p)
{
ptrdiff_t rest = strlen (s);
- int len;
const unsigned char *p = (const unsigned char *) s;
for (nchars = 0; rest > 0; ++nchars)
{
- string_char_and_length (p, &len);
+ int len = BYTES_BY_CHAR_HEAD (*p);
rest -= len, p += len;
}
}
@@ -3819,8 +3813,7 @@ compute_stop_pos (struct it *it)
ptrdiff_t bpos = CHAR_TO_BYTE (pos);
while (pos < endpos)
{
- int ch;
- FETCH_CHAR_ADVANCE_NO_CHECK (ch, pos, bpos);
+ int ch = fetch_char_advance_no_check (&pos, &bpos);
if (ch == ' ' || ch == '\t' || ch == '\n' || ch == '\f')
{
found = true;
@@ -4479,10 +4472,8 @@ face_before_or_after_it_pos (struct it *it, bool
before_p)
{
struct text_pos pos1 = string_pos (charpos, it->string);
const unsigned char *p = SDATA (it->string) + BYTEPOS (pos1);
- int c, len;
struct face *face = FACE_FROM_ID (it->f, face_id);
-
- c = string_char_and_length (p, &len);
+ int len, c = check_char_and_length (p, &len);
face_id = FACE_FOR_CHAR (it->f, face, c, charpos, it->string);
}
}
@@ -6577,7 +6568,7 @@ back_to_previous_line_start (struct it *it)
{
ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it);
- DEC_BOTH (cp, bp);
+ dec_both (&cp, &bp);
IT_CHARPOS (*it) = find_newline_no_quit (cp, bp, -1, &IT_BYTEPOS (*it));
}
@@ -8391,7 +8382,7 @@ next_element_from_string (struct it *it)
{
const unsigned char *s = (SDATA (it->string)
+ IT_STRING_BYTEPOS (*it));
- it->c = string_char_and_length (s, &it->len);
+ it->c = check_char_and_length (s, &it->len);
}
else
{
@@ -8429,7 +8420,7 @@ next_element_from_string (struct it *it)
{
const unsigned char *s = (SDATA (it->string)
+ IT_STRING_BYTEPOS (*it));
- it->c = string_char_and_length (s, &it->len);
+ it->c = check_char_and_length (s, &it->len);
}
else
{
@@ -8487,7 +8478,7 @@ next_element_from_c_string (struct it *it)
BYTEPOS (it->position) = CHARPOS (it->position) = -1;
}
else if (it->multibyte_p)
- it->c = string_char_and_length (it->s + IT_BYTEPOS (*it), &it->len);
+ it->c = check_char_and_length (it->s + IT_BYTEPOS (*it), &it->len);
else
it->c = it->s[IT_BYTEPOS (*it)], it->len = 1;
@@ -8784,7 +8775,7 @@ next_element_from_buffer (struct it *it)
/* Get the next character, maybe multibyte. */
p = BYTE_POS_ADDR (IT_BYTEPOS (*it));
if (it->multibyte_p && !ASCII_CHAR_P (*p))
- it->c = STRING_CHAR_AND_LENGTH (p, it->len);
+ it->c = string_char_and_length (p, &it->len);
else
it->c = *p, it->len = 1;
@@ -9907,9 +9898,13 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int
to_x, int to_y, int to_vpos
This could happen when the first display element is
wider than the window, or if we have a wrap-prefix
that doesn't leave enough space after it to display
- even a single character. */
+ even a single character. We only do this for moving
+ through buffer text, as with display/overlay strings
+ we'd need to also compare it->object's, and this is
+ unlikely to happen in that case anyway. */
if (IT_CHARPOS (*it) == orig_charpos
- && it->method == orig_method)
+ && it->method == orig_method
+ && orig_method == GET_FROM_BUFFER)
set_iterator_to_next (it, false);
it->continuation_lines_width += it->current_x;
}
@@ -10073,7 +10068,7 @@ move_it_vertically_backward (struct it *it, int dy)
{
ptrdiff_t cp = IT_CHARPOS (*it), bp = IT_BYTEPOS (*it);
- DEC_BOTH (cp, bp);
+ dec_both (&cp, &bp);
cp = find_newline_no_quit (cp, bp, -1, NULL);
move_it_to (it, cp, -1, -1, -1, MOVE_TO_POS);
}
@@ -10667,32 +10662,26 @@ message_dolog (const char *m, ptrdiff_t nbytes, bool
nlflag, bool multibyte)
if (multibyte
&& NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- ptrdiff_t i;
- int c, char_bytes;
- char work[1];
-
/* Convert a multibyte string to single-byte
for the *Message* buffer. */
- for (i = 0; i < nbytes; i += char_bytes)
+ for (ptrdiff_t i = 0; i < nbytes; )
{
- c = string_char_and_length (msg + i, &char_bytes);
- work[0] = CHAR_TO_BYTE8 (c);
- insert_1_both (work, 1, 1, true, false, false);
+ int char_bytes, c = check_char_and_length (msg + i, &char_bytes);
+ char work = CHAR_TO_BYTE8 (c);
+ insert_1_both (&work, 1, 1, true, false, false);
+ i += char_bytes;
}
}
else if (! multibyte
&& ! NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
- ptrdiff_t i;
- int c, char_bytes;
- unsigned char str[MAX_MULTIBYTE_LENGTH];
/* Convert a single-byte string to multibyte
for the *Message* buffer. */
- for (i = 0; i < nbytes; i++)
+ for (ptrdiff_t i = 0; i < nbytes; i++)
{
- c = msg[i];
- MAKE_CHAR_MULTIBYTE (c);
- char_bytes = CHAR_STRING (c, str);
+ int c = make_char_multibyte (msg[i]);
+ unsigned char str[MAX_MULTIBYTE_LENGTH];
+ int char_bytes = CHAR_STRING (c, str);
insert_1_both ((char *) str, 1, char_bytes, true, false, false);
}
}
@@ -12444,7 +12433,6 @@ prepare_menu_bars (void)
continue;
if (!FRAME_TOOLTIP_P (f)
- && !FRAME_PARENT_FRAME (f)
&& (FRAME_ICONIFIED_P (f)
|| FRAME_VISIBLE_P (f) == 1
/* Exclude TTY frames that are obscured because they
@@ -12490,10 +12478,9 @@ prepare_menu_bars (void)
&& !XBUFFER (w->contents)->text->redisplay)
continue;
- if (FRAME_PARENT_FRAME (f))
- continue;
+ if (!FRAME_PARENT_FRAME (f))
+ menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
- menu_bar_hooks_run = update_menu_bar (f, false, menu_bar_hooks_run);
update_tab_bar (f, false);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (f, false);
@@ -12505,7 +12492,10 @@ prepare_menu_bars (void)
else
{
struct frame *sf = SELECTED_FRAME ();
- update_menu_bar (sf, true, false);
+
+ if (!FRAME_PARENT_FRAME (sf))
+ update_menu_bar (sf, true, false);
+
update_tab_bar (sf, true);
#ifdef HAVE_WINDOW_SYSTEM
update_tool_bar (sf, true);
@@ -21151,7 +21141,7 @@ get_overlay_arrow_glyph_row (struct window *w,
Lisp_Object overlay_arrow_string)
/* Get the next character. */
if (multibyte_p)
- it.c = it.char_to_display = string_char_and_length (p, &it.len);
+ it.c = it.char_to_display = check_char_and_length (p, &it.len);
else
{
it.c = it.char_to_display = *p, it.len = 1;
@@ -22504,7 +22494,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
required when scanning back, because max_pos will already
have a much larger value. */
if (CHARPOS (row->end.pos) > max_pos)
- INC_BOTH (max_pos, max_bpos);
+ inc_both (&max_pos, &max_bpos);
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
}
else if (CHARPOS (it->eol_pos) > 0)
@@ -22522,7 +22512,7 @@ find_row_edges (struct it *it, struct glyph_row *row,
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
else
{
- INC_BOTH (max_pos, max_bpos);
+ inc_both (&max_pos, &max_bpos);
SET_TEXT_POS (row->maxpos, max_pos, max_bpos);
}
}
@@ -23932,7 +23922,7 @@ See also `bidi-paragraph-direction'. */)
to make sure we are within that paragraph. To that end, find
the previous non-empty line. */
if (pos >= ZV && pos > BEGV)
- DEC_BOTH (pos, bytepos);
+ dec_both (&pos, &bytepos);
AUTO_STRING (trailing_white_space, "[\f\t ]*\n");
if (fast_looking_at (trailing_white_space,
pos, bytepos, ZV, ZV_BYTE, Qnil) > 0)
@@ -29279,7 +29269,7 @@ produce_stretch_glyph (struct it *it)
it2 = *it;
if (it->multibyte_p)
- it2.c = it2.char_to_display = STRING_CHAR_AND_LENGTH (p, it2.len);
+ it2.c = it2.char_to_display = string_char_and_length (p, &it2.len);
else
{
it2.c = it2.char_to_display = *p, it2.len = 1;
diff --git a/src/xfont.c b/src/xfont.c
index f6131dc..1563b43 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -166,7 +166,7 @@ xfont_encode_coding_xlfd (char *xlfd)
while (*p0)
{
- int c = STRING_CHAR_ADVANCE (p0);
+ int c = string_char_advance (&p0);
if (c >= 0x100)
return -1;
diff --git a/src/xterm.c b/src/xterm.c
index ae5dad9..afe9c3d 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -8706,7 +8706,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (nchars == nbytes)
ch = copy_bufptr[i], len = 1;
else
- ch = STRING_CHAR_AND_LENGTH (copy_bufptr + i, len);
+ ch = string_char_and_length (copy_bufptr + i, &len);
inev.ie.kind = (SINGLE_BYTE_CHAR_P (ch)
? ASCII_KEYSTROKE_EVENT
: MULTIBYTE_CHAR_KEYSTROKE_EVENT);
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
new file mode 100644
index 0000000..4c5522d
--- /dev/null
+++ b/test/lisp/apropos-tests.el
@@ -0,0 +1,133 @@
+;;; apropos-tests.el --- Tests for apropos.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <address@hidden>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'apropos)
+(require 'ert)
+
+(ert-deftest apropos-tests-words-to-regexp-1 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar") "baz")))
+ (should (string-match-p re "foobazbar"))
+ (should (string-match-p re "barbazfoo"))
+ (should-not (string-match-p re "foo-bar"))
+ (should-not (string-match-p re "foobazbazbar"))))
+
+(ert-deftest apropos-tests-words-to-regexp-2 ()
+ (let ((re (apropos-words-to-regexp '("foo" "bar" "baz") "-")))
+ (should-not (string-match-p re "foo"))
+ (should-not (string-match-p re "foobar"))
+ (should (string-match-p re "foo-bar"))
+ (should (string-match-p re "foo-baz"))))
+
+(ert-deftest apropos-tests-parse-pattern-1 ()
+ (apropos-parse-pattern '("foo"))
+ (should (string-match-p apropos-regexp "foo"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar")))
+
+(ert-deftest apropos-tests-parse-pattern-2 ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar")))
+
+(ert-deftest apropos-tests-parse-pattern-3 ()
+ (apropos-parse-pattern '("foo" "bar" "baz"))
+ (should (string-match-p apropos-regexp "foo-bar"))
+ (should (string-match-p apropos-regexp "foo-baz"))
+ (should (string-match-p apropos-regexp "bar-foo"))
+ (should (string-match-p apropos-regexp "bar-baz"))
+ (should (string-match-p apropos-regexp "baz-foo"))
+ (should (string-match-p apropos-regexp "baz-bar"))
+ (should-not (string-match-p apropos-regexp "foo"))
+ (should-not (string-match-p apropos-regexp "bar"))
+ (should-not (string-match-p apropos-regexp "baz"))
+ (should-not (string-match-p apropos-regexp "foo-foo"))
+ (should-not (string-match-p apropos-regexp "bar-bar"))
+ (should-not (string-match-p apropos-regexp "baz-baz")))
+
+(ert-deftest apropos-tests-parse-pattern-single-regexp ()
+ (apropos-parse-pattern "foo+bar")
+ (should-not (string-match-p apropos-regexp "fobar"))
+ (should (string-match-p apropos-regexp "foobar"))
+ (should (string-match-p apropos-regexp "fooobar")))
+
+(ert-deftest apropos-tests-parse-pattern-synonyms ()
+ (let ((apropos-synonyms '(("find" "open" "edit"))))
+ (apropos-parse-pattern '("open"))
+ (should (string-match-p apropos-regexp "find-file"))
+ (should (string-match-p apropos-regexp "open-file"))
+ (should (string-match-p apropos-regexp "edit-file"))))
+
+(ert-deftest apropos-tests-calc-scores ()
+ (let ((str "Return apropos score for string STR."))
+ (should (equal (apropos-calc-scores str '("apr")) '(7)))
+ (should (equal (apropos-calc-scores str '("apr" "str")) '(25 7)))
+ (should (equal (apropos-calc-scores str '("appr" "str")) '(25)))
+ (should-not (apropos-calc-scores str '("appr" "strr")))))
+
+(ert-deftest apropos-tests-score-str ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-str "baz")
+ (apropos-score-str "foo baz")
+ (apropos-score-str "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-doc ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-doc "baz")
+ (apropos-score-doc "foo baz")
+ (apropos-score-doc "foo bar baz"))))
+
+(ert-deftest apropos-tests-score-symbol ()
+ (apropos-parse-pattern '("foo" "bar"))
+ (should (< (apropos-score-symbol 'baz)
+ (apropos-score-symbol 'foo-baz)
+ (apropos-score-symbol 'foo-bar-baz))))
+
+(ert-deftest apropos-tests-true-hit ()
+ (should-not (apropos-true-hit "foo" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar" '("foo" "bar")))
+ (should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
+
+(ert-deftest apropos-tests-format-plist ()
+ (setplist 'foo '(a 1 b (2 3) c nil))
+ (apropos-parse-pattern '("b"))
+ (should (equal (apropos-format-plist 'foo ", ")
+ "a 1, b (2 3), c nil"))
+ (should (equal (apropos-format-plist 'foo ", " t)
+ "b (2 3)"))
+ (apropos-parse-pattern '("d"))
+ (should-not (apropos-format-plist 'foo ", " t)))
+
+(provide 'apropos-tests)
+;;; apropos-tests.el ends here
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
new file mode 100644
index 0000000..c9ef26a
--- /dev/null
+++ b/test/lisp/elide-head-tests.el
@@ -0,0 +1,62 @@
+;;; elide-head-tests.el --- Tests for elide-head.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <address@hidden>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'elide-head)
+(require 'ert)
+
+(ert-deftest elide-head-tests-elide-head ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (let ((o (car (overlays-at 14))))
+ (should (= (overlay-start o) 10))
+ (should (= (overlay-end o) 21))
+ (should (overlay-get o 'invisible))
+ (should (overlay-get o 'evaporate))))))
+
+(ert-deftest elide-head-tests-elide-head-with-prefix-arg ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (should (overlays-at 14))
+ (elide-head t)
+ (should-not (overlays-at 14)))))
+
+(ert-deftest elide-head-tests-show ()
+ (let ((elide-head-headers-to-hide '(("START" . "END"))))
+ (with-temp-buffer
+ (insert "foo\nSTART\nHIDDEN\nEND\nbar")
+ (elide-head)
+ (should (overlays-at 14))
+ (elide-head-show)
+ (should-not (overlays-at 14)))))
+
+(provide 'elide-head-tests)
+;;; elide-head-tests.el ends here
diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el
index 63c4c32..6c08023 100644
--- a/test/lisp/jsonrpc-tests.el
+++ b/test/lisp/jsonrpc-tests.el
@@ -114,7 +114,7 @@
(condition-case err
(progn
(jsonrpc-request conn 'delete-directory "~/tmp")
- (ert-fail "A `jsonrpc-error' should have been signalled!"))
+ (ert-fail "A `jsonrpc-error' should have been signaled!"))
(jsonrpc-error
(should (= -32601 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
@@ -124,7 +124,7 @@
(condition-case err
(progn
(jsonrpc-request conn '+ ["a" 2])
- (ert-fail "A `jsonrpc-error' should have been signalled!"))
+ (ert-fail "A `jsonrpc-error' should have been signaled!"))
(jsonrpc-error
(should (= -32603 (cdr (assoc 'jsonrpc-error-code (cdr err)))))))))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index eb3b029..fa71e26 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -766,7 +766,7 @@ See Bug#21722."
(,output-buf (if ,output-buffer-is-current ,caller-buf
(generate-new-buffer "output-buf")))
(emacs (expand-file-name invocation-name invocation-directory))
- (,command (format "%s -Q --batch --eval '(princ \"%s\")'"
+ (,command (format "%s -Q --batch --eval \"(princ \\\"%s\\\")\""
emacs ,str))
(inhibit-message t))
(unwind-protect
@@ -803,7 +803,7 @@ See Bug#21722."
(expected-point `((beg-last-out . ,(1+ (length str)))
(end-last-out . ,(1+ (* 2 (length str))))
(save-point . 1))))
- (dolist (output-buffer-is-current '(t ni))
+ (dolist (output-buffer-is-current '(nil))
(with-shell-command-dont-erase-buffer str output-buffer-is-current
(when (memq shell-command-dont-erase-buffer '(beg-last-out
end-last-out save-point))
(should (= (point) (alist-get shell-command-dont-erase-buffer
expected-point))))))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 1c35669..6e87cb9 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1313,4 +1313,18 @@ with parameters from the *Messages* buffer modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+(ert-deftest buffer-multibyte-overlong-sequences ()
+ (dolist (uni '("\xE0\x80\x80"
+ "\xF0\x80\x80\x80"
+ "\xF8\x8F\xBF\xBF\x80"))
+ (let ((multi (string-to-multibyte uni)))
+ (should
+ (string-equal
+ multi
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert uni)
+ (set-buffer-multibyte t)
+ (buffer-string)))))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 6673ac4..5d85fc7 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -112,7 +112,7 @@
(should-error (thread-join (current-thread))))
(ert-deftest threads-join-error ()
- "Test of error signalling from `thread-join'."
+ "Test of error signaling from `thread-join'."
:tags '(:unstable)
(skip-unless (featurep 'threads))
(let ((thread (make-thread #'threads-call-error)))