pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge branch 'master' into feature/tramp-thread-safe

Browse source
This commit is contained in:
Michael Albinus 2018-08-17 10:33:10 +02:00
commit 2ff7017956
179 changed files with 12329 additions and 6553 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

62
build-aux/config.sub vendored
View file

@ -569,12 +569,14 @@ case $basic_machine in
1750a | 580 \
| a29k \
| aarch64 | aarch64_be \
| abacus \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
| am33_2.0 \
| arc | arceb \
| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m | armv[78][arm] \
| avr | avr32 \
| asmjs \
| ba \
| be32 | be64 \
| bfin \
@ -628,7 +630,7 @@ case $basic_machine in
| riscv | riscv32 | riscv64 \
| rl78 | rx \
| score \
| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb | shbe | shle | sh[1234]le | sh[23]ele \
| sh64 | sh64le \
| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
@ -654,15 +656,18 @@ case $basic_machine in
leon|leon[3-9])
basic_machine=sparc-$basic_machine
;;
m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* | picochip-*)
;;
m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip)
basic_machine=$basic_machine-unknown
os=${os:-none}
;;
m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65)
;;
m9s12z | m68hcs12z | hcs12z | s12z)
basic_machine=s12z-unknown
os=${os:-none}
;;
m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'`
;;
ms1)
basic_machine=mt-unknown
@ -672,7 +677,8 @@ case $basic_machine in
;;
xgate)
basic_machine=$basic_machine-unknown
os=${os:-none}
;;
xgate-*)
;;
xscaleeb)
basic_machine=armeb-unknown
@ -689,22 +695,26 @@ case $basic_machine in
basic_machine=$basic_machine-pc
;;
# Recognize the basic CPU types with company name.
580-* \
1750a-* | 580-* \
| a29k-* \
| aarch64-* | aarch64_be-* \
| abacus-* \
| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
| alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
| arm-* | armbe-* | armle-* | armeb-* | armv*-* \
| alphapca5[67]-* | alpha64pca5[67]-* \
| am33_2.0-* \
| arc-* | arceb-* \
| arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \
| avr-* | avr32-* \
| asmjs-* \
| ba-* \
| be32-* | be64-* \
| bfin-* | bs2000-* \
| c[123]* | c30-* | [cjt]90-* | c4x-* \
| c8051-* | clipper-* | craynv-* | csky-* | cydra-* \
| d10v-* | d30v-* | dlx-* \
| e2k-* | elxsi-* \
| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
| d10v-* | d30v-* | dlx-* | dsp16xx-* \
| e2k-* | elxsi-* | epiphany-* \
| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \
| h8300-* | h8500-* \
| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
| hexagon-* \
@ -714,8 +724,8 @@ case $basic_machine in
| le32-* | le64-* \
| lm32-* \
| m32c-* | m32r-* | m32rle-* \
| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
| m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* | v70-* | w65-* \
| m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \
| microblaze-* | microblazeel-* \
| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
| mips16-* \
@ -739,6 +749,7 @@ case $basic_machine in
| mipsr5900-* | mipsr5900el-* \
| mipstx39-* | mipstx39el-* \
| mmix-* \
| mn10200-* | mn10300-* \
| moxie-* \
| mt-* \
| msp430-* \
@ -748,6 +759,7 @@ case $basic_machine in
| none-* | np1-* | ns16k-* | ns32k-* \
| open8-* \
| or1k*-* \
| or32-* \
| orion-* \
| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
@ -755,14 +767,15 @@ case $basic_machine in
| pyramid-* \
| riscv-* | riscv32-* | riscv64-* \
| rl78-* | romp-* | rs6000-* | rx-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
| score-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* | she[lb]-* | sh[lb]e-* \
| sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-* \
| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
| sparclite-* \
| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
| spu-* \
| tahoe-* \
| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
| tile*-* \
| tron-* \
| ubicom32-* \
| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
@ -787,9 +800,6 @@ case $basic_machine in
3b*)
basic_machine=we32k-att
;;
abacus)
basic_machine=abacus-unknown
;;
alliant | fx80)
basic_machine=fx80-alliant
;;
@ -805,9 +815,6 @@ case $basic_machine in
amiga | amiga-*)
basic_machine=m68k-unknown
;;
asmjs)
basic_machine=asmjs-unknown
;;
blackfin-*)
basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'`
os=linux
@ -1154,6 +1161,9 @@ case $basic_machine in
sh5el)
basic_machine=sh5le-unknown
;;
sh5el-*)
basic_machine=sh5le-`echo "$basic_machine" | sed 's/^[^-]*-//'`
;;
simso-wrs)
basic_machine=sparclite-wrs
os=vxworks
@ -1179,9 +1189,11 @@ case $basic_machine in
sun386 | sun386i | roadrunner)
basic_machine=i386-sun
;;
tile*-*)
;;
tile*)
basic_machine=$basic_machine-unknown
os=linux-gnu
os=${os:-linux-gnu}
;;
tx39)
basic_machine=mipstx39-unknown
@ -1214,7 +1226,6 @@ case $basic_machine in
;;
none)
basic_machine=none-none
os=${os:-none}
;;
# Here we handle the default manufacturer of certain CPU types. It is in
@ -1246,9 +1257,6 @@ case $basic_machine in
we32k)
basic_machine=we32k-att
;;
sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
basic_machine=sh-unknown
;;
cydra)
basic_machine=cydra-cydrome
;;
@ -1354,7 +1362,7 @@ case $os in
| amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \
| aos* | aros* | cloudabi* | sortix* \
| nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \
| clix* | riscos* | uniplus* | iris* | rtu* | xenix* \
| clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \
| knetbsd* | mirbsd* | netbsd* \
| bitrig* | openbsd* | solidbsd* | libertybsd* \
| ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \

30
configure.ac
View file

@ -966,6 +966,7 @@ AS_IF([test $gl_gcc_warnings = no],
nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning
nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations
nw="$nw -Wbad-function-cast" # These casts are no worse than others.
nw="$nw -Wabi" # Not useful, perceived as noise
# Emacs doesn't care about shadowing; see
# <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>.
@ -4302,6 +4303,32 @@ AC_SUBST(KRB5LIB)
AC_SUBST(DESLIB)
AC_SUBST(KRB4LIB)
AC_ARG_WITH([libgmp],
[AS_HELP_STRING([--without-libgmp],
[don't use the GNU Multiple Precision (GMP) library;
this is the default on systems lacking libgmp.])])
GMP_LIB=
GMP_OBJ=mini-gmp-emacs.o
HAVE_GMP=no
case $with_libgmp in
no) ;;
yes) HAVE_GMP=yes GMP_LIB=-lgmp;;
*) AC_CHECK_HEADERS([gmp.h],
[OLIBS=$LIBS
AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp])
LIBS=$OLIBS
case $ac_cv_search___gmpz_roinit_n in
'none needed') HAVE_GMP=yes;;
-*) HAVE_GMP=yes GMP_LIB=$ac_cv_search___gmpz_roinit_n;;
esac]);;
esac
if test "$HAVE_GMP" = yes; then
GMP_OBJ=
AC_DEFINE([HAVE_GMP], 1, [Define to 1 if you have recent-enough GMP.])
fi
AC_SUBST([GMP_LIB])
AC_SUBST([GMP_OBJ])
AC_CHECK_HEADERS(valgrind/valgrind.h)
AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
@ -5398,7 +5425,7 @@ emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2; do
THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2 GMP; do
case $opt in
CANNOT_DUMP) eval val=\${$opt} ;;
@ -5450,6 +5477,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use -lxft? ${HAVE_XFT}
Does Emacs use -lsystemd? ${HAVE_LIBSYSTEMD}
Does Emacs use -ljansson? ${HAVE_JSON}
Does Emacs use -lgmp? ${HAVE_GMP}
Does Emacs directly use zlib? ${HAVE_ZLIB}
Does Emacs have dynamic modules support? ${HAVE_MODULES}
Does Emacs use toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}

6
doc/emacs/display.texi
View file

@ -974,8 +974,10 @@ the buffer is loaded. For example, to highlight all occurrences of
the word ``whim'' using the default face (a yellow background), type
@kbd{M-s h r whim @key{RET} @key{RET}}. Any face can be used for
highlighting, Hi Lock provides several of its own and these are
pre-loaded into a list of default values. While being prompted
for a face use @kbd{M-n} and @kbd{M-p} to cycle through them.
pre-loaded into a list of default values. While being prompted for a
face use @kbd{M-n} and @kbd{M-p} to cycle through them. A prefix
numeric argument limits the highlighting to the corresponding
subexpression.
@vindex hi-lock-auto-select-face
Setting the option @code{hi-lock-auto-select-face} to a non-@code{nil}

13
doc/emacs/files.texi
View file

@ -1051,13 +1051,16 @@ separate file, without altering the file you actually use. This is
called @dfn{auto-saving}. It prevents you from losing more than a
limited amount of work if the system crashes.
@vindex auto-save-no-message
When Emacs determines that it is time for auto-saving, it considers
each buffer, and each is auto-saved if auto-saving is enabled for it
and it has been changed since the last time it was auto-saved. The
message @samp{Auto-saving...} is displayed in the echo area during
auto-saving, if any files are actually auto-saved. Errors occurring
during auto-saving are caught so that they do not interfere with the
execution of commands you have been typing.
and it has been changed since the last time it was auto-saved. When
the @code{auto-save-no-message} variable is set to @code{nil} (the
default), the message @samp{Auto-saving...} is displayed in the echo
area during auto-saving, if any files are actually auto-saved; to
disable these messages, customize the variable to a non-@code{nil}
value. Errors occurring during auto-saving are caught so that they do
not interfere with the execution of commands you have been typing.
@menu
* Files: Auto Save Files. The file where auto-saved changes are

11
doc/emacs/maintaining.texi
View file

@ -1987,9 +1987,14 @@ Restart one of the last 2 commands above, from the current location of point.
@kindex M-?
@findex xref-find-references
@kbd{M-?} finds all the references for the identifier at point. If
there's no identifier at point, or when invoked with a prefix
argument, the command prompts for the identifier, with completion. It
@kbd{M-?} finds all the references for the identifier at point,
prompting for the identifier as needed, with completion. Depending on
the current backend (@pxref{Xref}), the command may prompt even if it
finds a valid identifier at point. When invoked with a prefix
argument, it always prompts for the identifier. (If you want it to
prompt always, customize the value of the variable
@code{xref-prompt-for-identifier} to @code{t}; or set it to @code{nil}
to prompt only if there's no usable identifier at point.) The command
then presents the @file{*xref*} buffer with all the references to the
identifier, showing the file name and the line where the identifier is
referenced. The XREF mode commands are available in this buffer, see

14
doc/lispref/display.texi
View file

@ -3498,11 +3498,15 @@ cons @code{(@var{from} . @var{to})}, where @var{from} and @var{to} are
character codepoints. In that case, use @var{font-spec} for all the
characters in the range @var{from} and @var{to} (inclusive).
@var{character} may be a charset. In that case, use
@var{font-spec} for all character in the charsets.
@var{character} may be a charset (@pxref{Character Sets}). In that
case, use @var{font-spec} for all the characters in the charset.
@var{character} may be a script name. In that case, use
@var{font-spec} for all character in the charsets.
@var{character} may be a script name (@pxref{Character Properties}).
In that case, use @var{font-spec} for all the characters belonging to
the script.
@var{character} may be @code{nil}, which means to use @var{font-spec}
for any character which no font-spec is specified.
@var{font-spec} may be a font-spec object created by the function
@code{font-spec} (@pxref{Low-Level Font}).
@ -3512,7 +3516,7 @@ where @var{family} is a family name of a font (possibly including a
foundry name at the head), @var{registry} is a registry name of a font
(possibly including an encoding name at the tail).
@var{font-spec} may be a font name string.
@var{font-spec} may be a font name, a string.
@var{font-spec} may be @code{nil}, which explicitly specifies that
there's no font for the specified @var{character}. This is useful,

41
doc/lispref/internals.texi
View file

@ -246,8 +246,8 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes).
@cindex vector-like objects, storage
@cindex storage of vector-like Lisp objects
Beyond the basic vector, a lot of objects like window, buffer, and
frame are managed as if they were vectors. The corresponding C data
Beyond the basic vector, a lot of objects like markers, overlays and
buffers are managed as if they were vectors. The corresponding C data
structures include the @code{union vectorlike_header} field whose
@code{size} member contains the subtype enumerated by @code{enum pvec_type}
and an information about how many @code{Lisp_Object} fields this structure
@ -318,7 +318,6 @@ future allocations. So an overall result is:
@example
((@code{conses} @var{cons-size} @var{used-conses} @var{free-conses})
(@code{symbols} @var{symbol-size} @var{used-symbols} @var{free-symbols})
(@code{miscs} @var{misc-size} @var{used-miscs} @var{free-miscs})
(@code{strings} @var{string-size} @var{used-strings} @var{free-strings})
(@code{string-bytes} @var{byte-size} @var{used-bytes})
(@code{vectors} @var{vector-size} @var{used-vectors})
@ -334,7 +333,7 @@ Here is an example:
@example
(garbage-collect)
@result{} ((conses 16 49126 8058) (symbols 48 14607 0)
(miscs 40 34 56) (strings 32 2942 2607)
(strings 32 2942 2607)
(string-bytes 1 78607) (vectors 16 7247)
(vector-slots 8 341609 29474) (floats 8 71 102)
(intervals 56 27 26) (buffers 944 8)
@ -366,19 +365,6 @@ The number of symbols in use.
The number of symbols for which space has been obtained from
the operating system, but that are not currently being used.
@item misc-size
Internal size of a miscellaneous entity, i.e.,
@code{sizeof (union Lisp_Misc)}, which is a size of the
largest type enumerated in @code{enum Lisp_Misc_Type}.
@item used-miscs
The number of miscellaneous objects in use. These include markers
and overlays, plus certain objects not visible to users.
@item free-miscs
The number of miscellaneous objects for which space has been obtained
from the operating system, but that are not currently being used.
@item string-size
Internal size of a string header, i.e., @code{sizeof (struct Lisp_String)}.
@ -593,6 +579,8 @@ in this Emacs session.
@defvar vector-cells-consed
The total number of vector cells that have been allocated so far
in this Emacs session.
This includes vector-like objects such as markers and overlays, plus
certain objects not visible to users.
@end defvar
@defvar symbols-consed
@ -605,12 +593,6 @@ The total number of string characters that have been allocated so far
in this session.
@end defvar
@defvar misc-objects-consed
The total number of miscellaneous objects that have been allocated so
far in this session. These include markers and overlays, plus
certain objects not visible to users.
@end defvar
@defvar intervals-consed
The total number of intervals that have been allocated so far
in this Emacs session.
@ -1001,7 +983,7 @@ a special type to represent the pointers to all of them, which is known as
In C, the tagged pointer is an object of type @code{Lisp_Object}. Any
initialized variable of such a type always holds the value of one of the
following basic data types: integer, symbol, string, cons cell, float,
vectorlike or miscellaneous object. Each of these data types has the
or vectorlike object. Each of these data types has the
corresponding tag value. All tags are enumerated by @code{enum Lisp_Type}
and placed into a 3-bit bitfield of the @code{Lisp_Object}. The rest of the
bits is the value itself. Integers are immediate, i.e., directly
@ -1033,18 +1015,13 @@ Symbol, the unique-named entity commonly used as an identifier.
@item struct Lisp_Float
Floating-point value.
@item union Lisp_Misc
Miscellaneous kinds of objects which don't fit into any of the above.
@end table
These types are the first-class citizens of an internal type system.
Since the tag space is limited, all other types are the subtypes of either
@code{Lisp_Vectorlike} or @code{Lisp_Misc}. Vector subtypes are enumerated
Since the tag space is limited, all other types are the subtypes of
@code{Lisp_Vectorlike}. Vector subtypes are enumerated
by @code{enum pvec_type}, and nearly all complex objects like windows, buffers,
frames, and processes fall into this category. The rest of special types,
including markers and overlays, are enumerated by @code{enum Lisp_Misc_Type}
and form the set of subtypes of @code{Lisp_Misc}.
frames, and processes fall into this category.
Below there is a description of a few subtypes of @code{Lisp_Vectorlike}.
Buffer object represents the text to display and edit. Window is the part

130
doc/lispref/numbers.texi
View file

@ -14,9 +14,9 @@
fractional parts, such as @minus{}4.5, 0.0, and 2.71828. They can
also be expressed in exponential notation: @samp{1.5e2} is the same as
@samp{150.0}; here, @samp{e2} stands for ten to the second power, and
that is multiplied by 1.5. Integer computations are exact, though
they may overflow. Floating-point computations often involve rounding
errors, as the numbers have a fixed amount of precision.
that is multiplied by 1.5. Integer computations are exact.
Floating-point computations often involve rounding errors, as the
numbers have a fixed amount of precision.
@menu
* Integer Basics:: Representation and range of integers.
@ -34,7 +34,15 @@ errors, as the numbers have a fixed amount of precision.
@node Integer Basics
@section Integer Basics
The range of values for an integer depends on the machine. The
Integers in Emacs Lisp can have arbitrary precision.
Under the hood, though, there are two kinds of integers: smaller
ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}
Some functions in Emacs only accept fixnums. Also, while fixnums can
always be compared for equality with @code{eq}, bignums require the
use of @code{eql}.
The range of values for a fixnum depends on the machine. The
minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e.,
@ifnottex
@minus{}2**29
@ -49,9 +57,7 @@ to
@tex
@math{2^{29}-1}),
@end tex
but many machines provide a wider range. Many examples in this
chapter assume the minimum integer width of 30 bits.
@cindex overflow
but many machines provide a wider range.
The Lisp reader reads an integer as a nonempty sequence
of decimal digits with optional initial sign and optional
@ -91,14 +97,8 @@ For example:
#24r1k @result{} 44
@end example
If an integer is outside the Emacs range, the Lisp reader ordinarily
signals an overflow. However, if a too-large plain integer ends in a
period, the Lisp reader treats it as a floating-point number instead.
This lets an Emacs Lisp program specify a large integer that is
quietly approximated by a floating-point number on machines with
limited word width. For example, @samp{536870912.} is a
floating-point number if Emacs integers are only 30 bits wide and is
an integer otherwise.
An integer is read as a fixnum if it is in the correct range.
Otherwise, it will be read as a bignum.
To understand how various functions work on integers, especially the
bitwise operators (@pxref{Bitwise Operations}), it is often helpful to
@ -141,16 +141,6 @@ In binary, the decimal integer 4 is 100. Consequently,
0111...111111 (30 bits total)
@end example
Since the arithmetic functions do not check whether integers go
outside their range, when you add 1 to 536,870,911, the value is the
negative integer @minus{}536,870,912:
@example
(+ 1 536870911)
@result{} -536870912
@result{} 1000...000000 (30 bits total)
@end example
Many of the functions described in this chapter accept markers for
arguments in place of numbers. (@xref{Markers}.) Since the actual
arguments to such functions may be either numbers or markers, we often
@ -160,8 +150,8 @@ value is a marker, its position value is used and its buffer is ignored.
@cindex largest Lisp integer
@cindex maximum Lisp integer
@defvar most-positive-fixnum
The value of this variable is the largest integer that Emacs Lisp can
handle. Typical values are
The value of this variable is the largest ``small'' integer that Emacs
Lisp can handle. Typical values are
@ifnottex
2**29 @minus{} 1
@end ifnottex
@ -181,8 +171,8 @@ on 64-bit platforms.
@cindex smallest Lisp integer
@cindex minimum Lisp integer
@defvar most-negative-fixnum
The value of this variable is the smallest integer that Emacs Lisp can
handle. It is negative. Typical values are
The value of this variable is the smallest small integer that Emacs
Lisp can handle. It is negative. Typical values are
@ifnottex
@minus{}2**29
@end ifnottex
@ -327,6 +317,18 @@ use otherwise), but the @code{zerop} predicate requires a number as
its argument. See also @code{integer-or-marker-p} and
@code{number-or-marker-p}, in @ref{Predicates on Markers}.
@defun bignump object
This predicate tests whether its argument is a large integer, and
returns @code{t} if so, @code{nil} otherwise. Unlike small integers,
large integers can be @code{=} or @code{eql} even if they are not @code{eq}.
@end defun
@defun fixnump object
This predicate tests whether its argument is a small integer, and
returns @code{t} if so, @code{nil} otherwise. Small integers can be
compared with @code{eq}.
@end defun
@defun floatp object
This predicate tests whether its argument is floating point
and returns @code{t} if so, @code{nil} otherwise.
@ -367,17 +369,17 @@ if so, @code{nil} otherwise. The argument must be a number.
To test numbers for numerical equality, you should normally use
@code{=} instead of non-numeric comparison predicates like @code{eq},
@code{eql} and @code{equal}. Distinct floating-point objects can be
numerically equal. If you use @code{eq} to compare them, you test
whether they are the same @emph{object}; if you use @code{eql} or
@code{equal}, you test whether their values are
@code{eql} and @code{equal}. Distinct floating-point and large
integer objects can be numerically equal. If you use @code{eq} to
compare them, you test whether they are the same @emph{object}; if you
use @code{eql} or @code{equal}, you test whether their values are
@emph{indistinguishable}. In contrast, @code{=} uses numeric
comparison, and sometimes returns @code{t} when a non-numeric
comparison would return @code{nil} and vice versa. @xref{Float
Basics}.
In Emacs Lisp, each integer is a unique Lisp object.
Therefore, @code{eq} is equivalent to @code{=} where integers are
In Emacs Lisp, each small integer is a unique Lisp object.
Therefore, @code{eq} is equivalent to @code{=} where small integers are
concerned. It is sometimes convenient to use @code{eq} for comparing
an unknown value with an integer, because @code{eq} does not report an
error if the unknown value is not a number---it accepts arguments of
@ -405,15 +407,6 @@ Here's a function to do this:
fuzz-factor)))
@end example
@cindex CL note---integers vrs @code{eq}
@quotation
@b{Common Lisp note:} Comparing numbers in Common Lisp always requires
@code{=} because Common Lisp implements multi-word integers, and two
distinct integer objects can have the same numeric value. Emacs Lisp
can have just one integer object for any given value because it has a
limited range of integers.
@end quotation
@defun = number-or-marker &rest number-or-markers
This function tests whether all its arguments are numerically equal,
and returns @code{t} if so, @code{nil} otherwise.
@ -423,7 +416,8 @@ and returns @code{t} if so, @code{nil} otherwise.
This function acts like @code{eq} except when both arguments are
numbers. It compares numbers by type and numeric value, so that
@code{(eql 1.0 1)} returns @code{nil}, but @code{(eql 1.0 1.0)} and
@code{(eql 1 1)} both return @code{t}.
@code{(eql 1 1)} both return @code{t}. This can be used to compare
large integers as well as small ones.
@end defun
@defun /= number-or-marker1 number-or-marker2
@ -583,10 +577,6 @@ Except for @code{%}, each of these functions accepts both integer and
floating-point arguments, and returns a floating-point number if any
argument is floating point.
Emacs Lisp arithmetic functions do not check for integer overflow.
Thus @code{(1+ 536870911)} may evaluate to
@minus{}536870912, depending on your hardware.
@defun 1+ number-or-marker
This function returns @var{number-or-marker} plus 1.
For example,
@ -912,35 +902,6 @@ On the other hand, shifting one place to the right looks like this:
@noindent
As the example illustrates, shifting one place to the right divides the
value of a positive integer by two, rounding downward.
The function @code{lsh}, like all Emacs Lisp arithmetic functions, does
not check for overflow, so shifting left can discard significant bits
and change the sign of the number. For example, left shifting
536,870,911 produces @minus{}2 in the 30-bit implementation:
@example
(lsh 536870911 1) ; @r{left shift}
@result{} -2
@end example
In binary, the argument looks like this:
@example
@group
;; @r{Decimal 536,870,911}
0111...111111 (30 bits total)
@end group
@end example
@noindent
which becomes the following when left shifted:
@example
@group
;; @r{Decimal @minus{}2}
1111...111110 (30 bits total)
@end group
@end example
@end defun
@defun ash integer1 count
@ -967,19 +928,6 @@ looks like this:
@end group
@end example
In contrast, shifting the pattern of bits one place to the right with
@code{lsh} looks like this:
@example
@group
(lsh -6 -1) @result{} 536870909
;; @r{Decimal @minus{}6 becomes decimal 536,870,909.}
1111...111010 (30 bits total)
@result{}
0111...111101 (30 bits total)
@end group
@end example
Here are other examples:
@c !!! Check if lined up in smallbook format! XDVI shows problem

26
doc/lispref/objects.texi
View file

@ -166,7 +166,10 @@ latter are unique to Emacs Lisp.
@node Integer Type
@subsection Integer Type
The range of values for an integer depends on the machine. The
Under the hood, there are two kinds of integers---small integers,
called @dfn{fixnums}, and large integers, called @dfn{bignums}.
The range of values for a fixnum depends on the machine. The
minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e.,
@ifnottex
@minus{}2**29
@ -182,8 +185,14 @@ to
@math{2^{29}-1})
@end tex
but many machines provide a wider range.
Emacs Lisp arithmetic functions do not check for integer overflow. Thus
@code{(1+ 536870911)} is @minus{}536,870,912 if Emacs integers are 30 bits.
Bignums can have arbitrary precision. Operations that overflow a
fixnum will return a bignum instead.
Fixnums can be compared with @code{eq}, but bignums require
@code{eql} or @code{=}. The @code{fixnump} predicate can be used to
detect such small integers, and @code{bignump} can be used to detect
large integers.
The read syntax for integers is a sequence of (base ten) digits with an
optional sign at the beginning and an optional period at the end. The
@ -200,11 +209,6 @@ leading @samp{+} or a final @samp{.}.
@end example
@noindent
As a special exception, if a sequence of digits specifies an integer
too large or too small to be a valid integer object, the Lisp reader
reads it as a floating-point number (@pxref{Floating-Point Type}).
For instance, if Emacs integers are 30 bits, @code{536870912} is read
as the floating-point number @code{536870912.0}.
@xref{Numbers}, for more information.
@ -1895,6 +1899,9 @@ with references to further information.
@item arrayp
@xref{Array Functions, arrayp}.
@item bignump
@xref{Predicates on Numbers, floatp}.
@item bool-vector-p
@xref{Bool-Vectors, bool-vector-p}.
@ -1928,6 +1935,9 @@ with references to further information.
@item custom-variable-p
@xref{Variable Definitions, custom-variable-p}.
@item fixnump
@xref{Predicates on Numbers, floatp}.
@item floatp
@xref{Predicates on Numbers, floatp}.

6
doc/misc/gnus.texi
View file

@ -14320,6 +14320,12 @@ fetch all textual parts, while leaving the rest on the server.
If non-@code{nil}, record all @acronym{IMAP} commands in the
@samp{"*imap log*"} buffer.
@item nnimap-use-namespaces
If non-@code{nil}, omit the IMAP namespace prefix in nnimap group
names. If your IMAP mailboxes are called something like @samp{INBOX}
and @samp{INBOX.Lists.emacs}, but you'd like the nnimap group names to
be @samp{INBOX} and @samp{Lists.emacs}, you should enable this option.
@end table

13
doc/misc/tramp.texi
View file

@ -3290,7 +3290,9 @@ When including @value{tramp}'s messages in the bug report, increase
the verbosity level to 6 (@pxref{Traces and Profiles, Traces}) in the
@file{~/.emacs} file before repeating steps to the bug. Include the
contents of the @file{*tramp/foo*} and @file{*debug tramp/foo*}
buffers with the bug report.
buffers with the bug report. Both buffers could contain
non-@acronym{ASCII} characters which are relevant for analysis, append
the buffers as attachments to the bug report.
@strong{Note} that a verbosity level greater than 6 is not necessary
at this stage. Also note that a verbosity level of 6 or greater, the
@ -4021,6 +4023,15 @@ export EDITOR=/path/to/emacsclient.sh
@end example
@item
How to determine wheter a buffer is remote?
The buffer-local variable @code{default-directory} tells this. If the
form @code{(file-remote-p default-directory)} returns non-@code{nil},
the buffer is remote. See the optional arguments of
@code{file-remote-p} for determining details of the remote connection.
@item
How to disable other packages from calling @value{tramp}?

60
etc/NEWS
View file

@ -24,6 +24,12 @@ When you add a new item, use the appropriate mark if you are sure it applies,
* Installation Changes in Emacs 27.1
** Emacs now uses GMP, the GNU Multiple Precision library.
By default, if 'configure' does not find a suitable libgmp, it
arranges for the included mini-gmp library to be built and used.
The new 'configure' option --without-libgmp uses mini-gmp even if a
suitable libgmp is available.
** The new configure option '--with-json' adds support for JSON using
the Jansson library. It is on by default; use 'configure
--with-json=no' to build without Jansson support. The new JSON
@ -53,6 +59,18 @@ option --enable-check-lisp-object-type is therefore no longer as
useful and so is no longer enabled by default in developer builds,
to reduce differences between developer and production builds.
** Ibuffer
---
*** New toggle 'ibuffer-do-toggle-lock', bound to 'L'.
** Gnus
+++
*** The nnimap backend now has support for IMAP namespaces.
This feature can be enabled by setting the new 'nnimap-use-namespaces'
server variable to non-nil.
* Startup Changes in Emacs 27.1
@ -189,6 +207,11 @@ from a remote host.
This triggers to search the program on the remote host as indicated by
'default-directory'.
+++
** New variable 'auto-save-no-message'.
When set to t, no message will be shown when auto-saving (default
value: nil).
* Editing Changes in Emacs 27.1
@ -381,6 +404,10 @@ buffer with the article(s) attached.
*** 'erc-button-google-url' has been renamed 'erc-button-search-url'
and its value has been changed to Duck Duck Go.
** EUDC
*** XEmacs support has been removed.
** eww/shr
*** When opening external links in eww/shr (typically with the
@ -700,6 +727,19 @@ to signal the main thread, e.g., when they encounter an error.
+++
*** 'thread-join' returns the result of the finished thread now.
---
** thingatpt.el supports a new "thing" called 'uuid'.
A symbol 'uuid' can be passed to thing-at-point and it returns the
UUID at point.
** Interactive automatic highlighting
+++
*** 'highlight-regexp' can now highlight subexpressions.
The now command accepts a prefix numeric argument to choose the
subexpression.
* New Modes and Packages in Emacs 27.1
@ -767,15 +807,6 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t.
integer, Emacs now signals an error if the number is too large for the
implementation to format.
+++
** The Lisp reader now signals an overflow for plain decimal integers
that do not end in '.' and are outside Emacs range. Formerly the Lisp
reader silently converted them to floating-point numbers, and signaled
overflow only for integers with a radix that are outside machine range.
To get the old behavior, set the new, experimental variable
read-integer-overflow-as-float to t and please email
30408@debbugs.gnu.org if you need that.
---
** Some functions and variables obsolete since Emacs 22 have been removed:
archive-mouse-extract, assoc-ignore-case, assoc-ignore-representation,
@ -824,6 +855,12 @@ is backwards-compatible with versions of Emacs in which the old function
exists. See the node "Displaying Buffers in Side Windows" in the ELisp
manual for more details.
** garbage collection no longer treats miscellaneous objects specially;
they are now allocated like any other pseudovector. As a result, the
'garbage-collect' and 'memory-use-count' functions no longer return a
'misc' component, and the 'misc-objects-consed' variable has been
removed.
* Lisp Changes in Emacs 27.1
@ -833,6 +870,11 @@ Given a proper list as argument, this predicate returns its length;
otherwise, it returns nil. 'format-proper-list-p' is now an obsolete
alias for the new function.
+++
** Emacs Lisp integers can be of arbitrary precision. The new
predicates 'bignump' and 'fixnump' can be used to distinguish between
the types of integers.
** define-minor-mode automatically documents the meaning of ARG
+++

4
lib-src/emacsclient.c
View file

@ -1117,7 +1117,9 @@ find_tty (const char **tty_type, const char **tty_name, int noabort)
}
}
if (strcmp (type, "eterm") == 0)
const char *inside_emacs = egetenv ("INSIDE_EMACS");
if (inside_emacs && strstr (inside_emacs, ",term:")
&& strprefix ("eterm", type))
{
if (noabort)
return 0;

4
lib-src/etags.c
View file

@ -85,7 +85,9 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# define DEBUG true
#else
# define DEBUG false
# define NDEBUG /* disable assert */
# ifndef NDEBUG
# define NDEBUG /* disable assert */
# endif
#endif
#include <config.h>

4
lib/gnulib.mk.in
View file

@ -238,6 +238,8 @@ GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@
GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@
GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@
GMALLOC_OBJ = @GMALLOC_OBJ@
GMP_LIB = @GMP_LIB@
GMP_OBJ = @GMP_OBJ@
GNULIB_ALPHASORT = @GNULIB_ALPHASORT@
GNULIB_ATOLL = @GNULIB_ATOLL@
GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@
@ -1720,7 +1722,7 @@ BUILT_SOURCES += $(GETOPT_H) $(GETOPT_CDEFS_H)
# We need the following in order to create <getopt.h> when the system
# doesn't have one that works with the given compiler.
getopt.h: getopt.in.h $(top_builddir)/config.status
getopt.h: getopt.in.h $(top_builddir)/config.status $(ARG_NONNULL_H)
$(AM_V_GEN)rm -f $@-t $@ && \
{ echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \
sed -e 's|@''GUARD_PREFIX''@|GL|g' \

27
lib/regcomp.c
View file

@ -2684,15 +2684,14 @@ parse_dup_op (bin_tree_t *elem, re_string_t *regexp, re_dfa_t *dfa,
# ifdef RE_ENABLE_I18N
/* Convert the byte B to the corresponding wide character. In a
unibyte locale, treat B as itself if it is an encoding error.
In a multibyte locale, return WEOF if B is an encoding error. */
unibyte locale, treat B as itself. In a multibyte locale, return
WEOF if B is an encoding error. */
static wint_t
parse_byte (unsigned char b, re_charset_t *mbcset)
{
wint_t wc = __btowc (b);
return wc == WEOF && !mbcset ? b : wc;
return mbcset == NULL ? b : __btowc (b);
}
#endif
# endif
/* Local function for parse_bracket_exp only used in case of NOT _LIBC.
Build the range expression which starts from START_ELEM, and ends
@ -3531,18 +3530,10 @@ build_equiv_class (bitset_t sbcset, const unsigned char *name)
continue;
/* Compare only if the length matches and the collation rule
index is the same. */
if (len == weights[idx2 & 0xffffff] && (idx1 >> 24) == (idx2 >> 24))
{
int cnt = 0;
while (cnt <= len &&
weights[(idx1 & 0xffffff) + 1 + cnt]
== weights[(idx2 & 0xffffff) + 1 + cnt])
++cnt;
if (cnt > len)
bitset_set (sbcset, ch);
}
if (len == weights[idx2 & 0xffffff] && (idx1 >> 24) == (idx2 >> 24)
&& memcmp (weights + (idx1 & 0xffffff) + 1,
weights + (idx2 & 0xffffff) + 1, len) == 0)
bitset_set (sbcset, ch);
}
/* Check whether the array has enough space. */
if (BE (*equiv_class_alloc == mbcset->nequiv_classes, 0))
@ -3802,9 +3793,9 @@ free_charset (re_charset_t *cset)
# ifdef _LIBC
re_free (cset->coll_syms);
re_free (cset->equiv_classes);
# endif
re_free (cset->range_starts);
re_free (cset->range_ends);
# endif
re_free (cset->char_classes);
re_free (cset);
}

3
lib/verify.h
View file

@ -276,7 +276,8 @@ template <int w>
when 'assume' silences warnings even with older GCCs. */
# define assume(R) ((R) ? (void) 0 : __builtin_trap ())
#else
# define assume(R) ((void) (0 && (R)))
/* Some tools grok NOTREACHED, e.g., Oracle Studio 12.6. */
# define assume(R) ((R) ? (void) 0 : /*NOTREACHED*/ (void) 0)
#endif
/* @assert.h omit end@ */

2
lisp/Makefile.in
View file

@ -341,7 +341,7 @@ compile-clean:
if test -f "$$el" || test ! -f "$${el}c"; then :; else \
echo rm "$${el}c"; \
rm "$${el}c"; \
fi \
fi; \
done
.PHONY: gen-lisp leim semantic

418
lisp/calendar/todo-mode.el
View file

@ -1242,9 +1242,10 @@ this command should be used with caution."
(widen)
(todo-edit-mode)
(remove-overlays)
(display-warning 'todo (format "\
(display-warning
'todo (format "\
Type %s to return to Todo mode.
Type %s to return to Todo%s mode.
This also runs a file format check and signals an error if
the format has become invalid. However, this check cannot
@ -1254,7 +1255,12 @@ You can repair this inconsistency by invoking the command
`todo-repair-categories-sexp', but this will revert any
renumbering of the categories you have made, so you will
have to renumber them again (see `(todo-mode) Reordering
Categories')." (substitute-command-keys "\\[todo-edit-quit]"))))
Categories').
"
(substitute-command-keys "\\[todo-edit-quit]")
(if (equal "toda" (file-name-extension
(buffer-file-name)))
" Archive" ""))))
(defun todo-add-category (&optional file cat)
"Add a new category to a todo file.
@ -1830,7 +1836,6 @@ consist of the last todo items and the first done items."
(defvar todo-date-from-calendar nil
"Helper variable for setting item date from the Emacs Calendar.")
(defvar todo-insert-item--keys-so-far)
(defvar todo-insert-item--parameters)
(defun todo-insert-item (&optional arg)
@ -1852,8 +1857,7 @@ already been entered and which remain available. See
`(todo-mode) Inserting New Items' for details of the parameters,
their associated keys and their effects."
(interactive "P")
(setq todo-insert-item--keys-so-far "i")
(todo-insert-item--next-param nil (list arg) todo-insert-item--parameters))
(todo-insert-item--next-param (list arg) todo-insert-item--parameters nil "i"))
(defun todo-insert-item--basic (&optional arg diary-type date-type time where)
"Function implementing the core of `todo-insert-item'."
@ -2101,17 +2105,14 @@ the item at point."
(let (todo-show-with-done) (todo-category-select)))))
(if ov (delete-overlay ov)))))
(defvar todo-edit-item--param-key-alist)
(defvar todo-edit-done-item--param-key-alist)
(defun todo-edit-item (&optional arg)
"Choose an editing operation for the current item and carry it out."
(interactive "P")
(let ((marked (assoc (todo-current-category) todo-categories-with-marks)))
(cond ((and (todo-done-item-p) (not marked))
(todo-edit-item--next-key todo-edit-done-item--param-key-alist))
(todo-edit-item--next-key 'done arg))
((or marked (todo-item-string))
(todo-edit-item--next-key todo-edit-item--param-key-alist arg)))))
(todo-edit-item--next-key 'todo arg)))))
(defun todo-edit-item--text (&optional arg)
"Function providing the text editing facilities of `todo-edit-item'."
@ -2245,7 +2246,9 @@ made in the number or names of categories."
;; (todo-repair-categories-sexp)
;; Compare (todo-make-categories-list t) with sexp and if
;; different ask (todo-update-categories-sexp) ?
(todo-mode)
(if (equal (file-name-extension (buffer-file-name)) "toda")
(todo-archive-mode)
(todo-mode))
(let* ((cat-beg (concat "^" (regexp-quote todo-category-beg)
"\\(.*\\)$"))
(curline (buffer-substring-no-properties
@ -5099,7 +5102,7 @@ again."
(defun todo-check-format ()
"Signal an error if the current todo file is ill-formatted.
Otherwise return t. Display a message if the file is well-formed
Otherwise return t. Display a warning if the file is well-formed
but the categories sexp differs from the current value of
`todo-categories'."
(save-excursion
@ -5133,12 +5136,14 @@ but the categories sexp differs from the current value of
(forward-line)))
;; Warn user if categories sexp has changed.
(unless (string= ssexp cats)
(message (concat "The sexp at the beginning of the file differs "
"from the value of `todo-categories'.\n"
"If the sexp is wrong, you can fix it with "
"M-x todo-repair-categories-sexp,\n"
"but note this reverts any changes you have "
"made in the order of the categories."))))))
(display-warning 'todo "\
The sexp at the beginning of the file differs from the value of
`todo-categories'. If the sexp is wrong, you can fix it with
M-x todo-repair-categories-sexp, but note this reverts any
changes you have made in the order of the categories.
"
)))))
t)
(defun todo-item-start ()
@ -5523,12 +5528,14 @@ of each other."
;;; Generating and applying item insertion and editing key sequences
;; -----------------------------------------------------------------------------
;; Thanks to Stefan Monnier for suggesting dynamically generating item
;; insertion commands and their key bindings, and offering an elegant
;; implementation, which, however, relies on lexical scoping and so
;; cannot be used here until the Calendar code used by todo-mode.el is
;; converted to lexical binding. Hence, the following implementation
;; uses dynamic binding.
;; Thanks to Stefan Monnier for (i) not only suggesting dynamically
;; generating item insertion commands and their key bindings but also
;; offering an elegant implementation which, however, since it used
;; lexical binding, was at the time incompatible with the Calendar and
;; Diary code in todo-mode.el; and (ii) later making that code
;; compatible with lexical binding, so that his implementation, of
;; which the following is a somewhat expanded version, could be
;; realized in todo-mode.el.
(defconst todo-insert-item--parameters
'((default copy) (diary nonmarking) (calendar date dayname) time (here region))
@ -5536,91 +5543,33 @@ of each other."
Passed by `todo-insert-item' to `todo-insert-item--next-param' to
dynamically create item insertion commands.")
(defconst todo-insert-item--param-key-alist
'((default . "i")
(copy . "p")
(diary . "y")
(nonmarking . "k")
(calendar . "c")
(date . "d")
(dayname . "n")
(time . "t")
(here . "h")
(region . "r"))
"List pairing item insertion parameters with their completion keys.")
(defsubst todo-insert-item--keyof (param)
"Return key paired with item insertion PARAM."
(cdr (assoc param todo-insert-item--param-key-alist)))
(defun todo-insert-item--argsleft (key list)
"Return sublist of LIST whose first member corresponds to KEY."
(let (l sym)
(mapc (lambda (m)
(when (consp m)
(catch 'found1
(dolist (s m)
(when (equal key (todo-insert-item--keyof s))
(throw 'found1 (setq sym s))))))
(if sym
(progn
(push sym l)
(setq sym nil))
(push m l)))
list)
(setq list (reverse l)))
(memq (catch 'found2
(dolist (e todo-insert-item--param-key-alist)
(when (equal key (cdr e))
(throw 'found2 (car e)))))
list))
(defsubst todo-insert-item--this-key () (char-to-string last-command-event))
(defvar todo-insert-item--keys-so-far ""
"String of item insertion keys so far entered for this command.")
(defvar todo-insert-item--args nil)
(defvar todo-insert-item--argleft nil)
(defvar todo-insert-item--argsleft nil)
(defvar todo-insert-item--newargsleft nil)
(defun todo-insert-item--apply-args ()
"Build list of arguments for item insertion and apply them.
The list consists of item insertion parameters that can be passed
as insertion command arguments in fixed positions. If a position
in the list is not occupied by the corresponding parameter, it is
occupied by nil."
(let* ((arg (list (car todo-insert-item--args)))
(args (nconc (cdr todo-insert-item--args)
(list (car (todo-insert-item--argsleft
(todo-insert-item--this-key)
todo-insert-item--argsleft)))))
(arglist (if (= 4 (length args))
args
(let ((v (make-vector 4 nil)) elt)
(while args
(setq elt (pop args))
(cond ((memq elt '(diary nonmarking))
(aset v 0 elt))
((memq elt '(calendar date dayname))
(aset v 1 elt))
((eq elt 'time)
(aset v 2 elt))
((memq elt '(copy here region))
(aset v 3 elt))))
(append v nil)))))
(apply #'todo-insert-item--basic (nconc arg arglist))))
(defun todo-insert-item--next-param (last args argsleft)
"Build item insertion command from LAST, ARGS and ARGSLEFT and call it.
Dynamically generate key bindings, prompting with the keys
already entered and those still available."
(cl-assert argsleft)
(defun todo-insert-item--next-param (args params last keys-so-far)
"Generate and invoke an item insertion command.
Dynamically generate the command, its arguments ARGS and its key
binding by recursing through the list of parameters PARAMS,
taking the LAST from a sublist and prompting with KEYS-SO-FAR
keys already entered and those still available."
(cl-assert params)
(let* ((map (make-sparse-keymap))
(param-key-alist '((default . "i")
(copy . "p")
(diary . "y")
(nonmarking . "k")
(calendar . "c")
(date . "d")
(dayname . "n")
(time . "t")
(here . "h")
(region . "r")))
;; Return key paired with given item insertion parameter.
(key-of (lambda (param) (cdr (assoc param param-key-alist))))
;; The key just typed.
(this-key (lambda () (char-to-string last-command-event)))
(prompt nil)
(addprompt
(lambda (k name)
;; Add successively entered keys to the prompt and show what
;; possibilities remain.
(add-to-prompt
(lambda (key name)
(setq prompt
(concat prompt
(format
@ -5630,80 +5579,119 @@ already entered and those still available."
"%s=>%s"
(when (memq name '(copy nonmarking dayname region))
" }"))
(propertize k 'face 'todo-key-prompt)
name))))))
(setq todo-insert-item--args args)
(setq todo-insert-item--argsleft argsleft)
(propertize key 'face 'todo-key-prompt)
name)))))
;; Return the sublist of the given list of parameters whose
;; first member is paired with the given key.
(get-params
(lambda (key lst)
(setq lst (if (consp lst) lst (list lst)))
(let (l sym)
(mapc (lambda (m)
(when (consp m)
(catch 'found1
(dolist (s m)
(when (equal key (funcall key-of s))
(throw 'found1 (setq sym s))))))
(if sym
(progn
(push sym l)
(setq sym nil))
(push m l)))
lst)
(setq lst (reverse l)))
(memq (catch 'found2
(dolist (e param-key-alist)
(when (equal key (cdr e))
(throw 'found2 (car e)))))
lst)))
;; Build list of arguments for item insertion and then
;; execute the basic insertion function. The list consists of
;; item insertion parameters that can be passed as insertion
;; command arguments in fixed positions. If a position in
;; the list is not occupied by the corresponding parameter,
;; it is occupied by nil.
(gen-and-exec
(lambda ()
(let* ((arg (list (car args))) ; Possible prefix argument.
(rest (nconc (cdr args)
(list (car (funcall get-params
(funcall this-key)
params)))))
(parlist (if (= 4 (length rest))
rest
(let ((v (make-vector 4 nil)) elt)
(while rest
(setq elt (pop rest))
(cond ((memq elt '(diary nonmarking))
(aset v 0 elt))
((memq elt '(calendar date dayname))
(aset v 1 elt))
((eq elt 'time)
(aset v 2 elt))
((memq elt '(copy here region))
(aset v 3 elt))))
(append v nil)))))
(apply #'todo-insert-item--basic (nconc arg parlist)))))
;; Operate on a copy of the parameter list so the original is
;; not consumed, thus available for the next key typed.
(params0 params))
(when last
(if (memq last '(default copy))
(progn
(setq todo-insert-item--argsleft nil)
(todo-insert-item--apply-args))
(let ((k (todo-insert-item--keyof last)))
(funcall addprompt k (make-symbol (concat (symbol-name last) ":GO!")))
(define-key map (todo-insert-item--keyof last)
(setq params0 nil)
(funcall gen-and-exec))
(let ((key (funcall key-of last)))
(funcall add-to-prompt key (make-symbol
(concat (symbol-name last) ":GO!")))
(define-key map (funcall key-of last)
(lambda () (interactive)
(todo-insert-item--apply-args))))))
(while todo-insert-item--argsleft
(let ((x (car todo-insert-item--argsleft)))
(setq todo-insert-item--newargsleft (cdr todo-insert-item--argsleft))
(dolist (argleft (if (consp x) x (list x)))
(let ((k (todo-insert-item--keyof argleft)))
(funcall addprompt k argleft)
(define-key map k
(if (null todo-insert-item--newargsleft)
(lambda () (interactive)
(todo-insert-item--apply-args))
(lambda () (interactive)
(setq todo-insert-item--keys-so-far
(concat todo-insert-item--keys-so-far " "
(todo-insert-item--this-key)))
(todo-insert-item--next-param
(car (todo-insert-item--argsleft
(todo-insert-item--this-key)
todo-insert-item--argsleft))
(nconc todo-insert-item--args
(list (car (todo-insert-item--argsleft
(todo-insert-item--this-key)
todo-insert-item--argsleft))))
(cdr (todo-insert-item--argsleft
(todo-insert-item--this-key)
todo-insert-item--argsleft)))))))))
(setq todo-insert-item--argsleft todo-insert-item--newargsleft))
(when prompt (message "Press a key (so far `%s'): %s"
todo-insert-item--keys-so-far prompt))
(funcall gen-and-exec))))))
(while params0
(let* ((x (car params0))
(restparams (cdr params0)))
(dolist (param (if (consp x) x (list x)))
(let ((key (funcall key-of param)))
(funcall add-to-prompt key param)
(define-key map key
(if (null restparams)
(lambda () (interactive)
(funcall gen-and-exec))
(lambda () (interactive)
(setq keys-so-far (concat keys-so-far " " (funcall this-key)))
(todo-insert-item--next-param
(nconc args (list (car (funcall get-params
(funcall this-key) param))))
(cdr (funcall get-params (funcall this-key) params))
(car (funcall get-params (funcall this-key) param))
keys-so-far))))))
(setq params0 restparams)))
(set-transient-map map)
(setq todo-insert-item--argsleft argsleft)))
(when prompt (message "Press a key (so far `%s'): %s" keys-so-far prompt))
(setq params0 params)))
(defconst todo-edit-item--param-key-alist
'((edit . "e")
(header . "h")
(multiline . "m")
(diary . "y")
(nonmarking . "k")
(date . "d")
(time . "t"))
"Alist of item editing parameters and their keys.")
(defconst todo-edit-item--date-param-key-alist
'((full . "f")
(calendar . "c")
(today . "a")
(dayname . "n")
(year . "y")
(month . "m")
(daynum . "d"))
"Alist of item date editing parameters and their keys.")
(defconst todo-edit-done-item--param-key-alist
'((add/edit . "c")
(delete . "d"))
"Alist of done item comment editing parameters and their keys.")
(defvar todo-edit-item--prompt "Press a key (so far `e'): ")
(defun todo-edit-item--next-key (params &optional arg)
(let* ((p->k (mapconcat (lambda (elt)
(defun todo-edit-item--next-key (type &optional arg)
(let* ((todo-param-key-alist '((edit . "e")
(header . "h")
(multiline . "m")
(diary . "y")
(nonmarking . "k")
(date . "d")
(time . "t")))
(done-param-key-alist '((add/edit . "c")
(delete . "d")))
(date-param-key-alist '((full . "f")
(calendar . "c")
(today . "a")
(dayname . "n")
(year . "y")
(month . "m")
(daynum . "d")))
(params (pcase type
('todo todo-param-key-alist)
('done done-param-key-alist)
('date date-param-key-alist)))
(p->k (mapconcat (lambda (elt)
(format "%s=>%s"
(propertize (cdr elt) 'face
'todo-key-prompt)
@ -5712,31 +5700,32 @@ already entered and those still available."
'(add/edit delete))
" comment"))))
params " "))
(key-prompt (substitute-command-keys todo-edit-item--prompt))
(key-prompt (substitute-command-keys
(concat "Press a key (so far `e"
(if (eq type 'date) " d" "")
"'): ")))
(this-key (let ((key (read-key (concat key-prompt p->k))))
(and (characterp key) (char-to-string key))))
(this-param (car (rassoc this-key params))))
(pcase this-param
(`edit (todo-edit-item--text))
(`header (todo-edit-item--text 'include-header))
(`multiline (todo-edit-item--text 'multiline))
(`add/edit (todo-edit-item--text 'comment-edit))
(`delete (todo-edit-item--text 'comment-delete))
(`diary (todo-edit-item--diary-inclusion))
(`nonmarking (todo-edit-item--diary-inclusion 'nonmarking))
(`date (let ((todo-edit-item--prompt "Press a key (so far `e d'): "))
(todo-edit-item--next-key
todo-edit-item--date-param-key-alist arg)))
(`full (progn (todo-edit-item--header 'date)
('edit (todo-edit-item--text))
('header (todo-edit-item--text 'include-header))
('multiline (todo-edit-item--text 'multiline))
('add/edit (todo-edit-item--text 'comment-edit))
('delete (todo-edit-item--text 'comment-delete))
('diary (todo-edit-item--diary-inclusion))
('nonmarking (todo-edit-item--diary-inclusion 'nonmarking))
('date (todo-edit-item--next-key 'date arg))
('full (progn (todo-edit-item--header 'date)
(when todo-always-add-time-string
(todo-edit-item--header 'time))))
(`calendar (todo-edit-item--header 'calendar))
(`today (todo-edit-item--header 'today))
(`dayname (todo-edit-item--header 'dayname))
(`year (todo-edit-item--header 'year arg))
(`month (todo-edit-item--header 'month arg))
(`daynum (todo-edit-item--header 'day arg))
(`time (todo-edit-item--header 'time)))))
('calendar (todo-edit-item--header 'calendar))
('today (todo-edit-item--header 'today))
('dayname (todo-edit-item--header 'dayname))
('year (todo-edit-item--header 'year arg))
('month (todo-edit-item--header 'month arg))
('daynum (todo-edit-item--header 'day arg))
('time (todo-edit-item--header 'time)))))
;; -----------------------------------------------------------------------------
;;; Todo minibuffer utilities
@ -6732,32 +6721,19 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local todo-current-todo-file (file-truename (buffer-file-name)))
(setq-local todo-show-done-only t))
(defun todo-mode-external-set ()
"Set `todo-categories' externally to `todo-current-todo-file'."
(setq-local todo-current-todo-file todo-global-current-todo-file)
(let ((cats (with-current-buffer
;; Can't use find-buffer-visiting when
;; `todo-show-categories-table' is called on first
;; invocation of `todo-show', since there is then
;; no buffer visiting the current file.
(find-file-noselect todo-current-todo-file 'nowarn)
(or todo-categories
;; In Todo Edit mode todo-categories is now nil
;; since it uses same buffer as Todo mode but
;; doesn't have the latter's local variables.
(save-excursion
(goto-char (point-min))
(read (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))))))
(setq-local todo-categories cats)))
(define-derived-mode todo-edit-mode text-mode "Todo-Ed"
"Major mode for editing multiline todo items.
\\{todo-edit-mode-map}"
(todo-modes-set-1)
(todo-mode-external-set)
(if (> (buffer-size) (- (point-max) (point-min)))
;; Editing one item in an indirect buffer, so buffer-file-name is nil.
(setq-local todo-current-todo-file todo-global-current-todo-file)
;; When editing archive file, make sure it is current todo file.
(setq-local todo-current-todo-file (file-truename (buffer-file-name)))
;; Need this when editing the whole file to return to the category
;; editing was invoked from.
(setq-local todo-categories (todo-set-categories)))
(setq buffer-read-only nil))
(put 'todo-categories-mode 'mode-class 'special)
@ -6766,7 +6742,15 @@ Added to `window-configuration-change-hook' in Todo mode."
"Major mode for displaying and editing todo categories.
\\{todo-categories-mode-map}"
(todo-mode-external-set))
(setq-local todo-current-todo-file todo-global-current-todo-file)
(setq-local todo-categories
;; Can't use find-buffer-visiting when
;; `todo-show-categories-table' is called on first
;; invocation of `todo-show', since there is then no
;; buffer visiting the current file.
(with-current-buffer (find-file-noselect
todo-current-todo-file 'nowarn)
todo-categories)))
(put 'todo-filtered-items-mode 'mode-class 'special)

1
lisp/cus-start.el
View file

@ -345,6 +345,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
;; keyboard.c
(meta-prefix-char keyboard character)
(auto-save-interval auto-save integer)
(auto-save-no-message auto-save boolean "27.1")
(auto-save-timeout auto-save (choice (const :tag "off" nil)
(integer :format "%v")))
(echo-keystrokes minibuffer number)

4
lisp/emacs-lisp/byte-opt.el
View file

@ -1195,14 +1195,14 @@
window-width zerop))
(side-effect-and-error-free-fns
'(arrayp atom
bobp bolp bool-vector-p
bignump bobp bolp bool-vector-p
buffer-end buffer-list buffer-size buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p characterp
charsetp commandp cons consp
current-buffer current-global-map current-indentation
current-local-map current-minor-mode-maps current-time
eobp eolp eq equal eventp
floatp following-char framep
fixnump floatp following-char framep
get-largest-window get-lru-window
hash-table-p
identity ignore integerp integer-or-marker-p interactive-p

13
lisp/emacs-lisp/package.el
View file

@ -1754,6 +1754,15 @@ if it is still empty."
(indirect indirect-deps)
(t (delete-dups (append direct-deps indirect-deps))))))
(defun package--user-installed-p (package)
"Return non-nil if PACKAGE is a user-installed package.
PACKAGE is the package name, a symbol. Check whether the package
was installed into `package-user-dir' where we assume to have
control over."
(let* ((pkg-desc (cadr (assq package package-alist)))
(dir (package-desc-dir pkg-desc)))
(file-in-directory-p dir package-user-dir)))
(defun package--removable-packages ()
"Return a list of names of packages no longer needed.
These are packages which are neither contained in
@ -1763,7 +1772,9 @@ These are packages which are neither contained in
;; `p' and its dependencies are needed.
append (cons p (package--get-deps p)))))
(cl-loop for p in (mapcar #'car package-alist)
unless (memq p needed)
unless (or (memq p needed)
;; Do not auto-remove external packages.
(not (package--user-installed-p p)))
collect p)))
(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all)

2
lisp/files.el
View file

@ -1895,7 +1895,7 @@ killed."
;; softly-dedicated.
(let ((newbuf
(find-file-noselect filename nil nil wildcards async)))
(switch-to-buffer newbuf)))
(switch-to-buffer (if (consp newbuf) (car newbuf) newbuf))))
(when (eq obuf (current-buffer))
;; This executes if find-file gets an error
;; and does not really find anything.

93
lisp/gnus/nnimap.el
View file

@ -55,6 +55,13 @@
If nnimap-stream is `ssl', this will default to `imaps'. If not,
it will default to `imap'.")
(defvoo nnimap-use-namespaces nil
"Whether to use IMAP namespaces.
If in Gnus your folder names in all start with (e.g.) `INBOX',
you probably want to set this to t. The effects of this are
purely cosmetic, but changing this variable will affect the
names of your nnimap groups. ")
(defvoo nnimap-stream 'undecided
"How nnimap talks to the IMAP server.
The value should be either `undecided', `ssl' or `tls',
@ -110,6 +117,8 @@ some servers.")
(defvoo nnimap-current-infos nil)
(defvoo nnimap-namespace nil)
(defun nnimap-decode-gnus-group (group)
(decode-coding-string group 'utf-8))
@ -166,6 +175,19 @@ textual parts.")
(defvar nnimap-inhibit-logging nil)
(defun nnimap-group-to-imap (group)
"Convert Gnus group name to IMAP mailbox name."
(let* ((inbox (if nnimap-namespace
(substring nnimap-namespace 0 -1) nil)))
(utf7-encode
(cond ((or (not inbox)
(string-equal group inbox))
group)
((string-prefix-p "#" group)
(substring group 1))
(t
(concat nnimap-namespace group))) t)))
(defun nnimap-buffer ()
(nnimap-find-process-buffer nntp-server-buffer))
@ -442,7 +464,8 @@ textual parts.")
(props (cdr stream-list))
(greeting (plist-get props :greeting))
(capabilities (plist-get props :capabilities))
(stream-type (plist-get props :type)))
(stream-type (plist-get props :type))
(server (nnoo-current-server 'nnimap)))
(when (and stream (not (memq (process-status stream) '(open run))))
(setq stream nil))
@ -475,9 +498,7 @@ textual parts.")
;; the virtual server name and the address
(nnimap-credentials
(gnus-delete-duplicates
(list
(nnoo-current-server 'nnimap)
nnimap-address))
(list server nnimap-address))
ports
nnimap-user))))
(setq nnimap-object nil)
@ -496,8 +517,17 @@ textual parts.")
(dolist (response (cddr (nnimap-command "CAPABILITY")))
(when (string= "CAPABILITY" (upcase (car response)))
(setf (nnimap-capabilities nnimap-object)
(mapcar #'upcase (cdr response))))))
;; If the login failed, then forget the credentials
(mapcar #'upcase (cdr response)))))
(when (and nnimap-use-namespaces
(nnimap-capability "NAMESPACE"))
(erase-buffer)
(nnimap-wait-for-response (nnimap-send-command "NAMESPACE"))
(let ((response (nnimap-last-response-string)))
(when (string-match
"^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+"
response)
(setq nnimap-namespace (match-string 1 response))))))
;; If the login failed, then forget the credentials
;; that are now possibly cached.
(dolist (host (list (nnoo-current-server 'nnimap)
nnimap-address))
@ -837,7 +867,7 @@ textual parts.")
(with-current-buffer (nnimap-buffer)
(erase-buffer)
(let ((group-sequence
(nnimap-send-command "SELECT %S" (utf7-encode group t)))
(nnimap-send-command "SELECT %S" (nnimap-group-to-imap group)))
(flag-sequence
(nnimap-send-command "UID FETCH 1:* FLAGS")))
(setf (nnimap-group nnimap-object) group)
@ -870,13 +900,13 @@ textual parts.")
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "CREATE %S" (utf7-encode group t))))))
(car (nnimap-command "CREATE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-delete-group (group &optional _force server)
(setq group (nnimap-decode-gnus-group group))
(when (nnimap-change-group nil server)
(with-current-buffer (nnimap-buffer)
(car (nnimap-command "DELETE %S" (utf7-encode group t))))))
(car (nnimap-command "DELETE %S" (nnimap-group-to-imap group))))))
(deffoo nnimap-request-rename-group (group new-name &optional server)
(setq group (nnimap-decode-gnus-group group))
@ -884,7 +914,7 @@ textual parts.")
(with-current-buffer (nnimap-buffer)
(nnimap-unselect-group)
(car (nnimap-command "RENAME %S %S"
(utf7-encode group t) (utf7-encode new-name t))))))
(nnimap-group-to-imap group) (nnimap-group-to-imap new-name))))))
(defun nnimap-unselect-group ()
;; Make sure we don't have this group open read/write by asking
@ -944,7 +974,7 @@ textual parts.")
"UID COPY %d %S"))
(result (nnimap-command
command article
(utf7-encode internal-move-group t))))
(nnimap-group-to-imap internal-move-group))))
(when (and (car result) (not can-move))
(nnimap-delete-article article))
(cons internal-move-group
@ -1011,7 +1041,7 @@ textual parts.")
"UID MOVE %s %S"
"UID COPY %s %S")
(nnimap-article-ranges (gnus-compress-sequence articles))
(utf7-encode (gnus-group-real-name nnmail-expiry-target) t))
(nnimap-group-to-imap (gnus-group-real-name nnmail-expiry-target)))
(set (if can-move 'deleted-articles 'articles-to-delete) articles))))
t)
(t
@ -1136,7 +1166,7 @@ If LIMIT, first try to limit the search to the N last articles."
(unsubscribe "UNSUBSCRIBE")))))
(when command
(with-current-buffer (nnimap-buffer)
(nnimap-command "%s %S" (cadr command) (utf7-encode group t)))))))
(nnimap-command "%s %S" (cadr command) (nnimap-group-to-imap group)))))))
(deffoo nnimap-request-set-mark (group actions &optional server)
(setq group (nnimap-decode-gnus-group group))
@ -1191,7 +1221,7 @@ If LIMIT, first try to limit the search to the N last articles."
(nnimap-unselect-group))
(erase-buffer)
(setq sequence (nnimap-send-command
"APPEND %S {%d}" (utf7-encode group t)
"APPEND %S {%d}" (nnimap-group-to-imap group)
(length message)))
(unless nnimap-streaming
(nnimap-wait-for-connection "^[+]"))
@ -1271,8 +1301,12 @@ If LIMIT, first try to limit the search to the N last articles."
(defun nnimap-get-groups ()
(erase-buffer)
(let ((sequence (nnimap-send-command "LIST \"\" \"*\""))
groups)
(let* ((sequence (nnimap-send-command "LIST \"\" \"*\""))
(prefix nnimap-namespace)
(prefix-len (if prefix (length prefix) nil))
(inbox (if prefix
(substring prefix 0 -1) nil))
groups)
(nnimap-wait-for-response sequence)
(subst-char-in-region (point-min) (point-max)
?\\ ?% t)
@ -1289,11 +1323,16 @@ If LIMIT, first try to limit the search to the N last articles."
(skip-chars-backward " \r\"")
(point)))))
(unless (member '%NoSelect flags)
(push (utf7-decode (if (stringp group)
group
(format "%s" group))
t)
groups))))
(let* ((group (utf7-decode (if (stringp group) group
(format "%s" group)) t))
(group (cond ((or (not prefix)
(equal inbox group))
group)
((string-prefix-p prefix group)
(substring group prefix-len))
(t
(concat "#" group)))))
(push group groups)))))
(nreverse groups)))
(defun nnimap-get-responses (sequences)
@ -1319,7 +1358,7 @@ If LIMIT, first try to limit the search to the N last articles."
(dolist (group groups)
(setf (nnimap-examined nnimap-object) group)
(push (list (nnimap-send-command "EXAMINE %S"
(utf7-encode group t))
(nnimap-group-to-imap group))
group)
sequences))
(nnimap-wait-for-response (caar sequences))
@ -1391,7 +1430,7 @@ If LIMIT, first try to limit the search to the N last articles."
unexist)
(push
(list (nnimap-send-command "EXAMINE %S (%s (%s %s))"
(utf7-encode group t)
(nnimap-group-to-imap group)
(nnimap-quirk "QRESYNC")
uidvalidity modseq)
'qresync
@ -1413,7 +1452,7 @@ If LIMIT, first try to limit the search to the N last articles."
(cl-incf (nnimap-initial-resync nnimap-object))
(setq start 1))
(push (list (nnimap-send-command "%s %S" command
(utf7-encode group t))
(nnimap-group-to-imap group))
(nnimap-send-command "UID FETCH %d:* FLAGS" start)
start group command)
sequences))))
@ -1847,7 +1886,7 @@ Return the server's response to the SELECT or EXAMINE command."
(if read-only
"EXAMINE"
"SELECT")
(utf7-encode group t))))
(nnimap-group-to-imap group))))
(when (car result)
(setf (nnimap-group nnimap-object) group
(nnimap-select-result nnimap-object) result)
@ -2105,7 +2144,7 @@ Return the server's response to the SELECT or EXAMINE command."
(dolist (spec specs)
(when (and (not (member (car spec) groups))
(not (eq (car spec) 'junk)))
(nnimap-command "CREATE %S" (utf7-encode (car spec) t))))
(nnimap-command "CREATE %S" (nnimap-group-to-imap (car spec)))))
;; Then copy over all the messages.
(erase-buffer)
(dolist (spec specs)
@ -2121,7 +2160,7 @@ Return the server's response to the SELECT or EXAMINE command."
"UID MOVE %s %S"
"UID COPY %s %S")
(nnimap-article-ranges ranges)
(utf7-encode group t))
(nnimap-group-to-imap group))
ranges)
sequences)))))
;; Wait for the last COPY response...

23
lisp/hi-lock.el
View file

@ -429,10 +429,12 @@ highlighting will not update as you type."
;;;###autoload
(defalias 'highlight-regexp 'hi-lock-face-buffer)
;;;###autoload
(defun hi-lock-face-buffer (regexp &optional face)
(defun hi-lock-face-buffer (regexp &optional face subexp)
"Set face of each match of REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
Use the global history list for FACE. Limit face setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@ -441,10 +443,11 @@ highlighting will not update as you type."
(list
(hi-lock-regexp-okay
(read-regexp "Regexp to highlight" 'regexp-history-last))
(hi-lock-read-face-name)))
(hi-lock-read-face-name)
current-prefix-arg))
(or (facep face) (setq face 'hi-yellow))
(unless hi-lock-mode (hi-lock-mode 1))
(hi-lock-set-pattern regexp face))
(hi-lock-set-pattern regexp face subexp))
;;;###autoload
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@ -686,11 +689,14 @@ with completion and history."
(add-to-list 'hi-lock-face-defaults face t))
(intern face)))
(defun hi-lock-set-pattern (regexp face)
"Highlight REGEXP with face FACE."
(defun hi-lock-set-pattern (regexp face &optional subexp)
"Highlight SUBEXP of REGEXP with face FACE.
If omitted or nil, SUBEXP defaults to zero, i.e. the entire
REGEXP is highlighted."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
(let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))
(setq subexp (or subexp 0))
(let ((pattern (list regexp (list subexp (list 'quote face) 'prepend)))
(no-matches t))
;; Refuse to highlight a text that is already highlighted.
(if (assoc regexp hi-lock-interactive-patterns)
@ -712,7 +718,8 @@ with completion and history."
(goto-char search-start)
(while (re-search-forward regexp search-end t)
(when no-matches (setq no-matches nil))
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
(let ((overlay (make-overlay (match-beginning subexp)
(match-end subexp))))
(overlay-put overlay 'hi-lock-overlay t)
(overlay-put overlay 'hi-lock-overlay-regexp regexp)
(overlay-put overlay 'face face))

27
lisp/ibuffer.el
View file

@ -579,6 +579,7 @@ directory, like `default-directory'."
(define-key map (kbd "R") 'ibuffer-do-rename-uniquely)
(define-key map (kbd "S") 'ibuffer-do-save)
(define-key map (kbd "T") 'ibuffer-do-toggle-read-only)
(define-key map (kbd "L") 'ibuffer-do-toggle-lock)
(define-key map (kbd "r") 'ibuffer-do-replace-regexp)
(define-key map (kbd "V") 'ibuffer-do-revert)
(define-key map (kbd "W") 'ibuffer-do-view-and-eval)
@ -851,6 +852,10 @@ directory, like `default-directory'."
'(menu-item "Print" ibuffer-do-print))
(define-key-after operate-map [do-toggle-modified]
'(menu-item "Toggle modification flag" ibuffer-do-toggle-modified))
(define-key-after operate-map [do-toggle-read-only]
'(menu-item "Toggle read-only flag" ibuffer-do-toggle-read-only))
(define-key-after operate-map [do-toggle-lock]
'(menu-item "Toggle lock flag" ibuffer-do-toggle-lock))
(define-key-after operate-map [do-revert]
'(menu-item "Revert" ibuffer-do-revert
:help "Revert marked buffers to their associated file"))
@ -1349,6 +1354,16 @@ Otherwise, toggle read only status."
:modifier-p t)
(read-only-mode (if (integerp arg) arg 'toggle)))
(define-ibuffer-op ibuffer-do-toggle-lock (&optional arg)
"Toggle locked status in marked buffers.
If optional ARG is a non-negative integer, lock buffers.
If ARG is a negative integer or 0, unlock buffers.
Otherwise, toggle lock status."
(:opstring "toggled lock status in"
:interactive "P"
:modifier-p t)
(emacs-lock-mode (if (integerp arg) arg 'toggle)))
(define-ibuffer-op ibuffer-do-delete ()
"Kill marked buffers as with `kill-this-buffer'."
(:opstring "killed"
@ -1896,11 +1911,9 @@ If point is on a group name, this function operates on that group."
(let ((procs 0)
(files 0))
(dolist (string strings)
(if (string-match "\\(?:\\`([[:ascii:]]+)\\)" string)
(progn (setq procs (1+ procs))
(if (< (match-end 0) (length string))
(setq files (1+ files))))
(setq files (1+ files))))
(when (get-text-property 1 'ibuffer-process string)
(setq procs (1+ procs)))
(setq files (1+ files)))
(concat (cond ((zerop files) "No files")
((= 1 files) "1 file")
(t (format "%d files" files)))
@ -1912,7 +1925,8 @@ If point is on a group name, this function operates on that group."
(filename (ibuffer-make-column-filename buffer mark)))
(if proc
(concat (propertize (format "(%s %s)" proc (process-status proc))
'font-lock-face 'italic)
'font-lock-face 'italic
'ibuffer-process proc)
(if (> (length filename) 0)
(format " %s" filename)
""))
@ -2498,6 +2512,7 @@ Operations on marked buffers:
`\\[ibuffer-do-view-other-frame]' - View the marked buffers in another frame.
`\\[ibuffer-do-revert]' - Revert the marked buffers.
`\\[ibuffer-do-toggle-read-only]' - Toggle read-only state of marked buffers.
`\\[ibuffer-do-toggle-lock]' - Toggle lock state of marked buffers.
`\\[ibuffer-do-delete]' - Kill the marked buffers.
`\\[ibuffer-do-isearch]' - Do incremental search in the marked buffers.
`\\[ibuffer-do-isearch-regexp]' - Isearch for regexp in the marked buffers.

18
lisp/international/ccl.el
View file

@ -184,11 +184,19 @@
(defvar ccl-current-ic 0
"The current index for `ccl-program-vector'.")
;; The CCL compiled codewords are 28bits, but the CCL implementation
;; assumes that the codewords are sign-extended, so that data constants in
;; the upper part of the codeword are signed. This function truncates a
;; codeword to 28bits, and then sign extends the result to a fixnum.
(defun ccl-fixnum (code)
"Convert a CCL code word to a fixnum value."
(- (logxor (logand code #x0fffffff) #x08000000) #x08000000))
(defun ccl-embed-data (data &optional ic)
"Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
increment it. If IC is specified, embed DATA at IC."
(if ic
(aset ccl-program-vector ic data)
(aset ccl-program-vector ic (ccl-fixnum data))
(let ((len (length ccl-program-vector)))
(if (>= ccl-current-ic len)
(let ((new (make-vector (* len 2) nil)))
@ -196,7 +204,7 @@ increment it. If IC is specified, embed DATA at IC."
(setq len (1- len))
(aset new len (aref ccl-program-vector len)))
(setq ccl-program-vector new))))
(aset ccl-program-vector ccl-current-ic data)
(aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
(setq ccl-current-ic (1+ ccl-current-ic))))
(defun ccl-embed-symbol (symbol prop)
@ -230,7 +238,8 @@ proper index number for SYMBOL. PROP should be
`ccl-program-vector' at IC without altering the other bit field."
(let ((relative (- ccl-current-ic (1+ ic))))
(aset ccl-program-vector ic
(logior (aref ccl-program-vector ic) (ash relative 8)))))
(logior (aref ccl-program-vector ic)
(ccl-fixnum (ash relative 8))))))
(defun ccl-embed-code (op reg data &optional reg2)
"Embed CCL code for the operation OP and arguments REG and DATA in
@ -986,7 +995,8 @@ is a list of CCL-BLOCKs."
(defun ccl-get-next-code ()
"Return a CCL code in `ccl-code' at `ccl-current-ic'."
(prog1
(aref ccl-code ccl-current-ic)
(let ((code (aref ccl-code ccl-current-ic)))
(if (numberp code) (ccl-fixnum code) code))
(setq ccl-current-ic (1+ ccl-current-ic))))
(defun ccl-dump-1 ()

4
lisp/international/fontset.el
View file

@ -79,7 +79,7 @@
("cns11643.92p7-0" . chinese-cns11643-7)
("big5" . big5)
("viscii" . viscii)
("tis620" . thai-iso8859-11)
("tis620" . tis620-2533)
("microsoft-cp1251" . windows-1251)
("koi8-r" . koi8-r)
("jisx0213.2000-1" . japanese-jisx0213-1)
@ -139,7 +139,7 @@
(cyrillic-iso8859-5 . iso-8859-5)
(greek-iso8859-7 . iso-8859-7)
(arabic-iso8859-6 . iso-8859-6)
(thai-tis620 . thai-iso8859-11)
(thai-tis620 . tis620-2533)
(latin-jisx0201 . jisx0201)
(katakana-jisx0201 . jisx0201)
(chinese-big5-1 . big5)

24
lisp/international/iso-transl.el
View file

@ -234,18 +234,18 @@ sequence VECTOR. (VECTOR is normally one character long.)")
;; Language-specific translation lists.
(defvar iso-transl-language-alist
'(("Esperanto"
("C" . [?Æ])
("G" . [?Ø])
("H" . [?¦])
("J" . [?¬])
("S" . [?Þ])
("U" . [?Ý])
("c" . [?æ])
("g" . [?ø])
("h" . [?])
("j" . [?¼])
("s" . [?þ])
("u" . [?ý]))
("C" . [?Ĉ])
("G" . [?Ĝ])
("H" . [?Ĥ])
("J" . [?Ĵ])
("S" . [?Ŝ])
("U" . [?Ŭ])
("c" . [?ĉ])
("g" . [?ĝ])
("h" . [?ĥ])
("j" . [?ĵ])
("s" . [?ŝ])
("u" . [?ŭ]))
("French"
("C" . [?Ç])
("c" . [?ç]))

10
lisp/international/mule-conf.el
View file

@ -201,7 +201,6 @@
;; plus nbsp
(define-iso-single-byte-charset 'iso-8859-11 'thai-iso8859-11
"ISO/IEC 8859/11" "Latin/Thai" 166 ?T nil "8859-11")
(define-charset-alias 'tis620-2533 'thai-iso8859-11)
;; 8859-12 doesn't (yet?) exist.
@ -223,13 +222,20 @@
;; Can this be shared with 8859-11?
;; N.b. not all of these are defined in Unicode.
(define-charset 'thai-tis620
"TIS620.2533"
"MULE charset for TIS620.2533"
:short-name "TIS620.2533"
:iso-final-char ?T
:emacs-mule-id 133
:code-space [32 127]
:code-offset #x0E00)
(define-charset 'tis620-2533
"TIS620.2533, a.k.a. TIS-620. Like `thai-iso8859-11', but without NBSP."
:short-name "TIS620.2533"
:ascii-compatible-p t
:code-space [0 255]
:superset '(ascii (thai-tis620 . 128)))
(define-charset 'jisx0201
"JISX0201"
:short-name "JISX0201"

12
lisp/international/mule.el
View file

@ -2545,7 +2545,17 @@ This function is intended to be added to `auto-coding-functions'."
(let* ((match (match-string 2))
(sym (intern (downcase match))))
(if (coding-system-p sym)
sym
;; If the encoding tag is UTF-8 and the buffer's
;; encoding is one of the variants of UTF-8, use the
;; buffer's encoding. This allows, e.g., saving an
;; HTML file as UTF-8 with BOM when the tag says UTF-8.
(let ((sym-type (coding-system-type sym))
(bfcs-type
(coding-system-type buffer-file-coding-system)))
(if (and (coding-system-equal 'utf-8 sym-type)
(coding-system-equal 'utf-8 bfcs-type))
buffer-file-coding-system
sym))
(message "Warning: unknown coding system \"%s\"" match)
nil)))))

145
lisp/jsonrpc.el
View file

@ -6,7 +6,7 @@
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
;; Package-Requires: ((emacs "25.2"))
;; Version: 1.0.0
;; Version: 1.0.6
;; This is an Elpa :core package. Don't use functionality that is not
;; compatible with Emacs 25.2.
@ -74,7 +74,11 @@
:documentation "A hash table of request ID to continuation lambdas.")
(-events-buffer
:accessor jsonrpc--events-buffer
:documentation "A buffer pretty-printing the JSON-RPC RPC events")
:documentation "A buffer pretty-printing the JSONRPC events")
(-events-buffer-scrollback-size
:initarg :events-buffer-scrollback-size
:accessor jsonrpc--events-buffer-scrollback-size
:documentation "Max size of events buffer. 0 disables, nil means infinite.")
(-deferred-actions
:initform (make-hash-table :test #'equal)
:accessor jsonrpc--deferred-actions
@ -193,9 +197,7 @@ dispatcher in CONNECTION."
(when timer (cancel-timer timer)))
(remhash id (jsonrpc--request-continuations connection))
(if error (funcall (nth 1 continuations) error)
(funcall (nth 0 continuations) result)))
(;; An abnormal situation
id (jsonrpc--warn "No continuation for id %s" id)))
(funcall (nth 0 continuations) result))))
(jsonrpc--call-deferred connection))))
@ -256,37 +258,62 @@ Returns nil."
(apply #'jsonrpc--async-request-1 connection method params args)
nil)
(cl-defun jsonrpc-request (connection method params &key deferred timeout)
(cl-defun jsonrpc-request (connection
method params &key
deferred timeout
cancel-on-input
cancel-on-input-retval)
"Make a request to CONNECTION, wait for a reply.
Like `jsonrpc-async-request' for CONNECTION, METHOD and PARAMS,
but synchronous, i.e. this function doesn't exit until anything
interesting (success, error or timeout) happens. Furthermore, it
only exits locally (returning the JSONRPC result object) if the
request is successful, otherwise exit non-locally with an error
of type `jsonrpc-error'.
but synchronous.
DEFERRED is passed to `jsonrpc-async-request', which see."
Except in the case of a non-nil CANCEL-ON-INPUT (explained
below), this function doesn't exit until anything interesting
happens (success reply, error reply, or timeout). Furthermore,
it only exits locally (returning the JSONRPC result object) if
the request is successful, otherwise it exits non-locally with an
error of type `jsonrpc-error'.
DEFERRED is passed to `jsonrpc-async-request', which see.
If CANCEL-ON-INPUT is non-nil and the user inputs something while
the functino is waiting, then it exits immediately, returning
CANCEL-ON-INPUT-RETVAL. Any future replies (normal or error) are
ignored."
(let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
cancelled
(retval
(unwind-protect ; protect against user-quit, for example
(unwind-protect
(catch tag
(setq
id-and-timer
(jsonrpc--async-request-1
connection method params
:success-fn (lambda (result) (throw tag `(done ,result)))
:success-fn (lambda (result)
(unless cancelled
(throw tag `(done ,result))))
:error-fn
(jsonrpc-lambda
(&key code message data)
(throw tag `(error (jsonrpc-error-code . ,code)
(jsonrpc-error-message . ,message)
(jsonrpc-error-data . ,data))))
(unless cancelled
(throw tag `(error (jsonrpc-error-code . ,code)
(jsonrpc-error-message . ,message)
(jsonrpc-error-data . ,data)))))
:timeout-fn
(lambda ()
(throw tag '(error (jsonrpc-error-message . "Timed out"))))
(unless cancelled
(throw tag '(error (jsonrpc-error-message . "Timed out")))))
:deferred deferred
:timeout timeout))
(while t (accept-process-output nil 30)))
(cond (cancel-on-input
(while (sit-for 30))
(setq cancelled t)
`(cancelled ,cancel-on-input-retval))
(t (while t (accept-process-output nil 30)))))
;; In normal operation, cancellation is handled by the
;; timeout function and response filter, but we still have
;; to protect against user-quit (C-g) or the
;; `cancel-on-input' case.
(pcase-let* ((`(,id ,timer) id-and-timer))
(remhash id (jsonrpc--request-continuations connection))
(remhash (list deferred (current-buffer))
@ -388,16 +415,22 @@ connection object, called when the process dies .")
"Return non-nil if JSONRPC connection CONN is running."
(process-live-p (jsonrpc--process conn)))
(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection))
"Shutdown the JSONRPC connection CONN."
(cl-loop
with proc = (jsonrpc--process conn)
do
(delete-process proc)
(accept-process-output nil 0.1)
while (not (process-get proc 'jsonrpc-sentinel-done))
do (jsonrpc--warn
"Sentinel for %s still hasn't run, deleting it!" proc)))
(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection)
&optional cleanup)
"Wait for JSONRPC connection CONN to shutdown.
With optional CLEANUP, kill any associated buffers. "
(unwind-protect
(cl-loop
with proc = (jsonrpc--process conn)
do
(delete-process proc)
(accept-process-output nil 0.1)
while (not (process-get proc 'jsonrpc-sentinel-done))
do (jsonrpc--warn
"Sentinel for %s still hasn't run, deleting it!" proc))
(when cleanup
(kill-buffer (process-buffer (jsonrpc--process conn)))
(kill-buffer (jsonrpc-stderr-buffer conn)))))
(defun jsonrpc-stderr-buffer (conn)
"Get CONN's standard error buffer, if any."
@ -629,27 +662,39 @@ TIMEOUT is nil)."
CONNECTION is the current connection. MESSAGE is a JSON-like
plist. TYPE is a symbol saying if this is a client or server
originated."
(with-current-buffer (jsonrpc-events-buffer connection)
(cl-destructuring-bind (&key method id error &allow-other-keys) message
(let* ((inhibit-read-only t)
(subtype (cond ((and method id) 'request)
(method 'notification)
(id 'reply)
(t 'message)))
(type
(concat (format "%s" (or type 'internal))
(if type
(format "-%s" subtype)))))
(goto-char (point-max))
(let ((msg (format "%s%s%s %s:\n%s\n"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
(current-time-string)
(pp-to-string message))))
(when error
(setq msg (propertize msg 'face 'error)))
(insert-before-markers msg))))))
(let ((max (jsonrpc--events-buffer-scrollback-size connection)))
(when (or (null max) (cl-plusp max))
(with-current-buffer (jsonrpc-events-buffer connection)
(cl-destructuring-bind (&key method id error &allow-other-keys) message
(let* ((inhibit-read-only t)
(subtype (cond ((and method id) 'request)
(method 'notification)
(id 'reply)
(t 'message)))
(type
(concat (format "%s" (or type 'internal))
(if type
(format "-%s" subtype)))))
(goto-char (point-max))
(prog1
(let ((msg (format "%s%s%s %s:\n%s\n"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
(current-time-string)
(pp-to-string message))))
(when error
(setq msg (propertize msg 'face 'error)))
(insert-before-markers msg))
;; Trim the buffer if it's too large
(when max
(save-excursion
(goto-char (point-min))
(while (> (buffer-size) max)
(delete-region (point) (progn (forward-line 1)
(forward-sexp 1)
(forward-line 2)
(point)))))))))))))
(provide 'jsonrpc)
;;; jsonrpc.el ends here

4
lisp/language/thai.el
View file

@ -36,7 +36,7 @@
"8-bit encoding for ASCII (MSB=0) and Thai TIS620 (MSB=1)."
:coding-type 'charset
:mnemonic ?T
:charset-list '(thai-iso8859-11))
:charset-list '(tis620-2533))
(define-coding-system-alias 'th-tis620 'thai-tis620)
(define-coding-system-alias 'tis620 'thai-tis620)
@ -47,7 +47,7 @@
(charset thai-tis620)
(coding-system thai-tis620 iso-8859-11 cp874)
(coding-priority thai-tis620)
(nonascii-translation . iso-8859-11)
(nonascii-translation . tis620-2533)
(input-method . "thai-kesmanee")
(unibyte-display . thai-tis620)
(features thai-util)

117
lisp/net/eudc-bob.el
View file

@ -25,8 +25,15 @@
;;; Commentary:
;; eudc-bob.el presents binary entries in LDAP results in interactive
;; ways. For example, it will display JPEG binary data as an inline
;; image in the results buffer. See also
;; https://tools.ietf.org/html/rfc2798.
;;; Usage:
;; See the corresponding info file
;; The eudc-bob interactive functions are invoked when the user
;; interacts with an `eudc-query-form' results buffer.
;;; Code:
@ -148,40 +155,21 @@ display a button."
"Toggle inline display of an image."
(interactive)
(when (eudc-bob-can-display-inline-images)
(cond ((featurep 'xemacs)
(let ((overlays (append (overlays-at (1- (point)))
(overlays-at (point))))
overlay glyph)
(setq overlay (car overlays))
(while (and overlay
(not (setq glyph (overlay-get overlay 'glyph))))
(setq overlays (cdr overlays))
(setq overlay (car overlays)))
(if overlay
(if (overlay-get overlay 'end-glyph)
(progn
(overlay-put overlay 'end-glyph nil)
(overlay-put overlay 'invisible nil))
(overlay-put overlay 'end-glyph glyph)
(overlay-put overlay 'invisible t)))))
(t
(let* ((overlays (append (overlays-at (1- (point)))
(overlays-at (point))))
image)
;; Search overlay with an image.
(while (and overlays (null image))
(let ((prop (overlay-get (car overlays) 'eudc-image)))
(if (eq 'image (car-safe prop))
(setq image prop)
(setq overlays (cdr overlays)))))
;; Toggle that overlay's image display.
(when overlays
(let ((overlay (car overlays)))
(overlay-put overlay 'display
(if (overlay-get overlay 'display)
nil image)))))))))
(let* ((overlays (append (overlays-at (1- (point)))
(overlays-at (point))))
image)
;; Search overlay with an image.
(while (and overlays (null image))
(let ((prop (overlay-get (car overlays) 'eudc-image)))
(if (eq 'image (car-safe prop))
(setq image prop)
(setq overlays (cdr overlays)))))
;; Toggle that overlay's image display.
(when overlays
(let ((overlay (car overlays)))
(overlay-put overlay 'display
(if (overlay-get overlay 'display)
nil image)))))))
(defun eudc-bob-display-audio (data)
"Display a button for audio DATA."
@ -265,25 +253,19 @@ display a button."
(interactive "@e")
(run-hooks 'activate-menubar-hook)
(eudc-jump-to-event event)
(if (featurep 'xemacs)
(progn
(run-hooks 'activate-popup-menu-hook)
(popup-menu (eudc-bob-menu)))
(let ((result (x-popup-menu t (eudc-bob-menu)))
command)
(if result
(progn
(setq command (lookup-key (eudc-bob-menu)
(apply 'vector result)))
(command-execute command))))))
(let ((result (x-popup-menu t (eudc-bob-menu)))
command)
(if result
(progn
(setq command (lookup-key (eudc-bob-menu)
(apply 'vector result)))
(command-execute command)))))
(setq eudc-bob-generic-keymap
(let ((map (make-sparse-keymap)))
(define-key map "s" 'eudc-bob-save-object)
(define-key map "!" 'eudc-bob-pipe-object-to-external-program)
(define-key map (if (featurep 'xemacs)
[button3]
[down-mouse-3]) 'eudc-bob-popup-menu)
(define-key map [down-mouse-3] 'eudc-bob-popup-menu)
map))
(setq eudc-bob-image-keymap
@ -294,25 +276,19 @@ display a button."
(setq eudc-bob-sound-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'eudc-bob-play-sound-at-point)
(define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'eudc-bob-play-sound-at-mouse)
(define-key map [down-mouse-2] 'eudc-bob-play-sound-at-mouse)
map))
(setq eudc-bob-url-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'browse-url-at-point)
(define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'browse-url-at-mouse)
(define-key map [down-mouse-2] 'browse-url-at-mouse)
map))
(setq eudc-bob-mail-keymap
(let ((map (make-sparse-keymap)))
(define-key map [return] 'goto-address-at-point)
(define-key map (if (featurep 'xemacs)
[button2]
[down-mouse-2]) 'goto-address-at-point)
(define-key map [down-mouse-2] 'goto-address-at-point)
map))
(set-keymap-parent eudc-bob-image-keymap eudc-bob-generic-keymap)
@ -320,19 +296,18 @@ display a button."
;; If the first arguments can be nil here, then these 3 can be
;; defconsts once more.
(when (not (featurep 'xemacs))
(easy-menu-define eudc-bob-generic-menu
eudc-bob-generic-keymap
""
eudc-bob-generic-menu)
(easy-menu-define eudc-bob-image-menu
eudc-bob-image-keymap
""
eudc-bob-image-menu)
(easy-menu-define eudc-bob-sound-menu
eudc-bob-sound-keymap
""
eudc-bob-sound-menu))
(easy-menu-define eudc-bob-generic-menu
eudc-bob-generic-keymap
""
eudc-bob-generic-menu)
(easy-menu-define eudc-bob-image-menu
eudc-bob-image-keymap
""
eudc-bob-image-menu)
(easy-menu-define eudc-bob-sound-menu
eudc-bob-sound-keymap
""
eudc-bob-sound-menu)
;;;###autoload
(defun eudc-display-generic-binary (data)

10
lisp/net/eudc-hotlist.el
View file

@ -55,11 +55,6 @@ These are the special commands of this mode:
t -- Transpose the server at point and the previous one
q -- Commit the changes and quit.
x -- Quit without committing the changes."
(when (featurep 'xemacs)
(setq mode-popup-menu eudc-hotlist-menu)
(when (featurep 'menubar)
(set-buffer-menubar current-menubar)
(add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))))
(setq buffer-read-only t))
;;;###autoload
@ -179,10 +174,9 @@ These are the special commands of this mode:
["Save and Quit" eudc-hotlist-quit-edit t]
["Exit without Saving" kill-this-buffer t]))
(when (not (featurep 'xemacs))
(easy-menu-define eudc-hotlist-emacs-menu
(easy-menu-define eudc-hotlist-emacs-menu
eudc-hotlist-mode-map
""
eudc-hotlist-menu))
eudc-hotlist-menu)
;;; eudc-hotlist.el ends here

69
lisp/net/eudc.el
View file

@ -630,9 +630,7 @@ These are the special commands of EUDC mode:
n -- Move to next record.
p -- Move to previous record.
b -- Insert record at point into the BBDB database."
(if (not (featurep 'xemacs))
(easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu))
(setq mode-popup-menu (eudc-menu))))
(easy-menu-define eudc-emacs-menu eudc-mode-map "" (eudc-menu)))
;;}}}
@ -1140,33 +1138,11 @@ queries the server for the existing fields and displays a corresponding form."
eudc-tail-menu)))
(defun eudc-install-menu ()
(cond
((and (featurep 'xemacs) (featurep 'menubar))
(add-submenu '("Tools") (eudc-menu)))
((not (featurep 'xemacs))
(cond
((fboundp 'easy-menu-create-menu)
(define-key
global-map
[menu-bar tools directory-search]
(cons "Directory Servers"
(easy-menu-create-menu "Directory Servers" (cdr (eudc-menu))))))
((fboundp 'easy-menu-add-item)
(let ((menu (eudc-menu)))
(easy-menu-add-item nil '("tools") (easy-menu-create-menu (car menu)
(cdr menu)))))
((fboundp 'easy-menu-create-keymaps)
(easy-menu-define eudc-menu-map eudc-mode-map "Directory Client Menu" (eudc-menu))
(define-key
global-map
[menu-bar tools eudc]
(cons "Directory Servers"
(easy-menu-create-keymaps "Directory Servers"
(cdr (eudc-menu))))))
(t
(error "Unknown version of easymenu"))))
))
(define-key
global-map
[menu-bar tools directory-search]
(cons "Directory Servers"
(easy-menu-create-menu "Directory Servers" (cdr (eudc-menu))))))
;;; Load time initializations :
@ -1182,7 +1158,7 @@ queries the server for the existing fields and displays a corresponding form."
(eudc-install-menu))
;; The following installs a short menu for EUDC at XEmacs startup.
;; The following installs a short menu for EUDC at Emacs startup.
;;;###autoload
(defun eudc-load-eudc ()
@ -1196,8 +1172,7 @@ This does nothing except loading eudc by autoload side-effect."
nil)
;;;###autoload
(cond
((not (featurep 'xemacs))
(progn
(defvar eudc-tools-menu
(let ((map (make-sparse-keymap "Directory Servers")))
(define-key map [phone]
@ -1222,34 +1197,6 @@ This does nothing except loading eudc by autoload side-effect."
:help ,(purecopy "Load the Emacs Unified Directory Client")))
map))
(fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu)))
(t
(let ((menu '("Directory Servers"
["Load Hotlist of Servers" eudc-load-eudc t]
["New Server" eudc-set-server t]
["---" nil nil]
["Query with Form" eudc-query-form t]
["Expand Inline Query" eudc-expand-inline t]
["---" nil nil]
["Get Email" eudc-get-email t]
["Get Phone" eudc-get-phone t])))
(if (not (featurep 'eudc-autoloads))
(if (featurep 'xemacs)
(if (and (featurep 'menubar)
(not (featurep 'infodock)))
(add-submenu '("Tools") menu))
(require 'easymenu)
(cond
((fboundp 'easy-menu-add-item)
(easy-menu-add-item nil '("tools")
(easy-menu-create-menu (car menu)
(cdr menu))))
((fboundp 'easy-menu-create-keymaps)
(define-key
global-map
[menu-bar tools eudc]
(cons "Directory Servers"
(easy-menu-create-keymaps "Directory Servers"
(cdr menu)))))))))))
;;}}}

40
lisp/net/eudcb-bbdb.el
View file

@ -47,10 +47,13 @@
BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
;; This just-in-time translation permits upgrading from BBDB 2 to
;; BBDB 3 without restarting Emacs.
(if (and (eq field-symbol 'net)
(eudc--using-bbdb-3-or-newer-p))
'mail
field-symbol))
(cond ((and (eq field-symbol 'net)
(eudc--using-bbdb-3-or-newer-p))
'mail)
((and (eq field-symbol 'company)
(eudc--using-bbdb-3-or-newer-p))
'organization)
(t field-symbol)))
(defvar eudc-bbdb-attributes-translation-alist
'((name . lastname)
@ -124,18 +127,31 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(declare-function bbdb-record-addresses "ext:bbdb" t) ; via bbdb-defstruct
(declare-function bbdb-records "ext:bbdb"
(&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-record-notes "ext:bbdb" t) ; via bbdb-defstruct
;; External, BBDB >= 3.
(declare-function bbdb-phone-label "ext:bbdb" t) ; via bbdb-defstruct
(declare-function bbdb-record-phone "ext:bbdb" t) ; via bbdb-defstruct
(declare-function bbdb-record-address "ext:bbdb" t) ; via bbdb-defstruct
(declare-function bbdb-record-xfield "ext:bbdb" t) ; via bbdb-defstruct
(defun eudc-bbdb-extract-phones (record)
(require 'bbdb)
(mapcar (function
(lambda (phone)
(if eudc-bbdb-use-locations-as-attribute-names
(cons (intern (bbdb-phone-location phone))
(cons (intern (if (eudc--using-bbdb-3-or-newer-p)
(bbdb-phone-label phone)
(bbdb-phone-location phone)))
(bbdb-phone-string phone))
(cons 'phones (format "%s: %s"
(bbdb-phone-location phone)
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-phone-label phone)
(bbdb-phone-location phone))
(bbdb-phone-string phone))))))
(bbdb-record-phones record)))
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-phone record)
(bbdb-record-phones record))))
(defun eudc-bbdb-extract-addresses (record)
(require 'bbdb)
@ -157,7 +173,9 @@ BBDB < 3 used `net'; BBDB >= 3 uses `mail'."
(cons (intern (bbdb-address-location address)) val)
(cons 'addresses (concat (bbdb-address-location address)
"\n" val))))
(bbdb-record-addresses record))))
(if (eudc--using-bbdb-3-or-newer-p)
(bbdb-record-address record)
(bbdb-record-addresses record)))))
(defun eudc-bbdb-format-record-as-result (record)
"Format the BBDB RECORD as a EUDC query result record.
@ -176,7 +194,11 @@ The record is filtered according to `eudc-bbdb-current-return-attributes'"
(setq val (eudc-bbdb-extract-phones record)))
((eq attr 'addresses)
(setq val (eudc-bbdb-extract-addresses record)))
((memq attr '(firstname lastname aka company net notes))
((eq attr 'notes)
(if (eudc--using-bbdb-3-or-newer-p)
(setq val (bbdb-record-xfield record 'notes))
(setq val (bbdb-record-notes record))))
((memq attr '(firstname lastname aka company net))
(setq val (eval
(list (intern
(concat "bbdb-record-"

6
lisp/progmodes/xref.el
View file

@ -869,7 +869,11 @@ buffer where the user can select from the list."
;;;###autoload
(defun xref-find-references (identifier)
"Find references to the identifier at point.
With prefix argument, prompt for the identifier."
This command might prompt for the identifier as needed, perhaps
offering the symbol at point as the default.
With prefix argument, or if `xref-prompt-for-identifier' is t,
always prompt for the identifier. If `xref-prompt-for-identifier'
is nil, prompt only if there's no usable symbol at point."
(interactive (list (xref--read-identifier "Find references of: ")))
(xref--find-xrefs identifier 'references identifier nil))

23
lisp/shadowfile.el
View file

@ -628,26 +628,17 @@ Consider them as regular expressions if third arg REGEXP is true."
(defun shadow-add-to-todo ()
"If current buffer has shadows, add them to the list needing to be copied."
(message "shadow-add-to-todo 1 %s" (current-buffer))
(message "shadow-add-to-todo 2 %s" (buffer-file-name))
(message "shadow-add-to-todo 3 %s" (shadow-expand-file-name (buffer-file-name (current-buffer))))
(message "shadow-add-to-todo 4 %s" (shadow-shadows-of (shadow-expand-file-name (buffer-file-name (current-buffer)))))
(let ((shadows (shadow-shadows-of
(shadow-expand-file-name
(buffer-file-name (current-buffer))))))
(when shadows
(message "shadow-add-to-todo 5 %s" shadows)
(message "shadow-add-to-todo 6 %s" shadow-files-to-copy)
(message "shadow-add-to-todo 7 %s" (shadow-union shadows shadow-files-to-copy))
(setq shadow-files-to-copy
(shadow-union shadows shadow-files-to-copy))
(when (not shadow-inhibit-message)
(message "%s" (substitute-command-keys
"Use \\[shadow-copy-files] to update shadows."))
(sit-for 1))
(message "shadow-add-to-todo 8")
(shadow-write-todo-file)
(message "shadow-add-to-todo 9")))
(shadow-write-todo-file)))
nil) ; Return nil for write-file-functions
(defun shadow-remove-from-todo (pair)
@ -714,26 +705,18 @@ defined, the old hashtable info is invalid."
"Write out information to `shadow-todo-file'.
With non-nil argument also saves the buffer."
(save-excursion
(message "shadow-write-todo-file 1 %s" shadow-todo-buffer)
(if (not shadow-todo-buffer)
(setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
(message "shadow-write-todo-file 2 %s" shadow-todo-buffer)
(set-buffer shadow-todo-buffer)
(message "shadow-write-todo-file 3 %s" shadow-todo-buffer)
(setq buffer-read-only nil)
(delete-region (point-min) (point-max))
(message "shadow-write-todo-file 4 %s" shadow-todo-buffer)
(shadow-insert-var 'shadow-files-to-copy)
(message "shadow-write-todo-file 5 %s" save)
(if save (shadow-save-todo-file))
(message "shadow-write-todo-file 6 %s" save)))
(if save (shadow-save-todo-file))))
(defun shadow-save-todo-file ()
(message "shadow-save-todo-file 1 %s" shadow-todo-buffer)
(if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
(with-current-buffer shadow-todo-buffer
(message "shadow-save-todo-file 2 %s" shadow-todo-buffer)
(condition-case nil ; have to continue even in case of
(condition-case nil ; have to continue even in case of
(basic-save-buffer) ; error, otherwise kill-emacs might
(error ; not work!
(message "WARNING: Can't save shadow todo file; it is locked!")

2
lisp/simple.el
View file

@ -6066,7 +6066,7 @@ into account variable-width characters and line continuation.
If nil, `line-move' moves point by logical lines.
A non-nil setting of `goal-column' overrides the value of this variable
and forces movement by logical lines.
A window that is horizontally scrolled also forces movement by logical
A window that is horizontally scrolled also forces movement by logical
lines."
:type 'boolean
:group 'editing-basics

4
lisp/startup.el
View file

@ -2534,9 +2534,9 @@ nil default-directory" name)
((eq initial-buffer-choice t)
(get-buffer-create "*scratch*"))
(t
(error "initial-buffer-choice must be a string, a function, or t.")))))
(error "`initial-buffer-choice' must be a string, a function, or t")))))
(unless (buffer-live-p buf)
(error "initial-buffer-choice is not a live buffer."))
(error "Value returned by `initial-buffer-choice' is not a live buffer: %S" buf))
(setq displayable-buffers (cons buf (delq buf displayable-buffers)))))
;; Display the first two buffers in `displayable-buffers'. If

37
lisp/textmodes/flyspell.el
View file

@ -1424,10 +1424,20 @@ determined by `flyspell-large-region'."
The list of incorrect words should be in `flyspell-external-ispell-buffer'.
\(We finish by killing that buffer and setting the variable to nil.)
The buffer to mark them in is `flyspell-large-region-buffer'."
(let (words-not-found
(ispell-otherchars (ispell-get-otherchars))
(buffer-scan-pos flyspell-large-region-beg)
case-fold-search)
(let* (words-not-found
(flyspell-casechars (flyspell-get-casechars))
(ispell-otherchars (ispell-get-otherchars))
(ispell-many-otherchars-p (ispell-get-many-otherchars-p))
(word-chars (concat flyspell-casechars
"+\\("
(if (not (string= "" ispell-otherchars))
(concat ispell-otherchars "?"))
flyspell-casechars
"+\\)"
(if ispell-many-otherchars-p
"*" "?")))
(buffer-scan-pos flyspell-large-region-beg)
case-fold-search)
(with-current-buffer flyspell-external-ispell-buffer
(goto-char (point-min))
;; Loop over incorrect words, in the order they were reported,
@ -1457,11 +1467,18 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;; Move back into the match
;; so flyspell-get-word will find it.
(forward-char -1)
(flyspell-get-word)))
;; Is this a word that matches the
;; current dictionary?
(if (looking-at word-chars)
(flyspell-get-word))))
(found (car found-list))
(found-length (length found))
(misspell-length (length word)))
(when (or
;; Misspelled word is not from the
;; language supported by the current
;; dictionary.
(null found)
;; Size matches, we really found it.
(= found-length misspell-length)
;; Matches as part of a boundary-char separated
@ -1483,13 +1500,21 @@ The buffer to mark them in is `flyspell-large-region-buffer'."
;; backslash) and none of the previous
;; conditions match.
(and (not ispell-really-aspell)
(not ispell-really-hunspell)
(not ispell-really-enchant)
(save-excursion
(goto-char (- (nth 1 found-list) 1))
(if (looking-at "[\\]" )
t
nil))))
(setq keep nil)
(flyspell-word nil t)
;; Don't try spell-checking words whose
;; characters don't match CASECHARS, because
;; flyspell-word will then consider as
;; misspelling the preceding word that matches
;; CASECHARS.
(or (null found)
(flyspell-word nil t))
;; Search for next misspelled word will begin from
;; end of last validated match.
(setq buffer-scan-pos (point))))

6
lisp/textmodes/ispell.el
View file

@ -1173,6 +1173,12 @@ dictionary from that list was found."
;; Parse and set values for default dictionary.
(setq hunspell-default-dict (or hunspell-multi-dict
(car hunspell-default-dict)))
;; If hunspell-default-dict is nil, ispell-parse-hunspell-affix-file
;; will barf with an error message that doesn't help users figure
;; out what is wrong. Produce an error message that points to the
;; root cause of the problem.
(or hunspell-default-dict
(error "Can't find Hunspell dictionary with a .aff affix file"))
(setq hunspell-default-dict-entry
(ispell-parse-hunspell-affix-file hunspell-default-dict))
;; Create an alist of found dicts with only names, except for default dict.

24
lisp/thingatpt.el
View file

@ -61,7 +61,7 @@
"Move forward to the end of the Nth next THING.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'."
(let ((forward-op (or (get thing 'forward-op)
(intern-soft (format "forward-%s" thing)))))
@ -76,7 +76,7 @@ Possibilities include `symbol', `list', `sexp', `defun',
"Determine the start and end buffer locations for the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', and `page'.
See the file `thingatpt.el' for documentation on how to define a
@ -134,7 +134,7 @@ positions of the thing found."
"Return the THING at point.
THING should be a symbol specifying a type of syntactic entity.
Possibilities include `symbol', `list', `sexp', `defun',
`filename', `url', `email', `word', `sentence', `whitespace',
`filename', `url', `email', `uuid', `word', `sentence', `whitespace',
`line', `number', and `page'.
When the optional argument NO-PROPERTIES is non-nil,
@ -564,6 +564,24 @@ with angle brackets.")
(put 'buffer 'end-op (lambda () (goto-char (point-max))))
(put 'buffer 'beginning-op (lambda () (goto-char (point-min))))
;; UUID
(defconst thing-at-point-uuid-regexp
(rx bow
(repeat 8 hex-digit) "-"
(repeat 4 hex-digit) "-"
(repeat 4 hex-digit) "-"
(repeat 4 hex-digit) "-"
(repeat 12 hex-digit)
eow)
"A regular expression matching a UUID.
See RFC 4122 for the description of the format.")
(put 'uuid 'bounds-of-thing-at-point
(lambda ()
(when (thing-at-point-looking-at thing-at-point-uuid-regexp 36)
(cons (match-beginning 0) (match-end 0)))))
;; Aliases
(defun word-at-point ()

30
lisp/vc/vc-hooks.el
View file

@ -692,24 +692,26 @@ visiting FILE.
If BACKEND is passed use it as the VC backend when computing the result."
(interactive (list buffer-file-name))
(setq backend (or backend (vc-backend file)))
(if (not backend)
(setq vc-mode nil)
(cond
((not backend)
(setq vc-mode nil))
((null vc-display-status)
(setq vc-mode (concat " " (symbol-name backend))))
(t
(let* ((ml-string (vc-call-backend backend 'mode-line-string file))
(ml-echo (get-text-property 0 'help-echo ml-string)))
(setq vc-mode
(concat
" "
(if (null vc-display-status)
(symbol-name backend)
(propertize
ml-string
'mouse-face 'mode-line-highlight
'help-echo
(concat (or ml-echo
(format "File under the %s version control system"
backend))
"\nmouse-1: Version Control menu")
'local-map vc-mode-line-map)))))
(propertize
ml-string
'mouse-face 'mode-line-highlight
'help-echo
(concat (or ml-echo
(format "File under the %s version control system"
backend))
"\nmouse-1: Version Control menu")
'local-map vc-mode-line-map))))
;; If the user is root, and the file is not owner-writable,
;; then pretend that we can't write it
;; even though we can (because root can write anything).
@ -718,7 +720,7 @@ If BACKEND is passed use it as the VC backend when computing the result."
(not buffer-read-only)
(zerop (user-real-uid))
(zerop (logand (file-modes buffer-file-name) 128))
(setq buffer-read-only t)))
(setq buffer-read-only t))))
(force-mode-line-update)
backend)

2
lisp/w32-fns.el
View file

@ -279,7 +279,7 @@ bit output with no translation."
(w32-add-charset-info "iso8859-9" 'w32-charset-turkish 1254)
(w32-add-charset-info "iso8859-13" 'w32-charset-baltic 1257)
(w32-add-charset-info "koi8-r" 'w32-charset-russian 20866)
(w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595)
(w32-add-charset-info "tis620-2533" 'w32-charset-russian 28595)
(w32-add-charset-info "iso8859-11" 'w32-charset-thai 874)
(w32-add-charset-info "windows-1258" 'w32-charset-vietnamese 1258)
(w32-add-charset-info "ksc5601.1992" 'w32-charset-johab 1361)

46
src/.gdbinit
View file

@ -649,17 +649,13 @@ define xtype
xgettype $
output $type
echo \n
if $type == Lisp_Misc
xmisctype
else
if $type == Lisp_Vectorlike
xvectype
end
if $type == Lisp_Vectorlike
xvectype
end
end
document xtype
Print the type of $, assuming it is an Emacs Lisp value.
If the first type printed is Lisp_Vector or Lisp_Misc,
If the first type printed is Lisp_Vectorlike,
a second line gives the more precise type.
end
@ -711,15 +707,6 @@ Print the size of $
This command assumes that $ is a Lisp_Object.
end
define xmisctype
xgetptr $
output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
echo \n
end
document xmisctype
Assume that $ is some misc type and print its specific type.
end
define xint
xgetint $
print $int
@ -754,15 +741,6 @@ Print $ as a overlay pointer.
This command assumes that $ is an Emacs Lisp overlay value.
end
define xmiscfree
xgetptr $
print (struct Lisp_Free *) $ptr
end
document xmiscfree
Print $ as a misc free-cell pointer.
This command assumes that $ is an Emacs Lisp Misc value.
end
define xsymbol
set $sym = $
xgetsym $sym
@ -1015,18 +993,6 @@ define xpr
if $type == Lisp_Float
xfloat
end
if $type == Lisp_Misc
set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
if $misc == Lisp_Misc_Free
xmiscfree
end
if $misc == Lisp_Misc_Marker
xmarker
end
if $misc == Lisp_Misc_Overlay
xoverlay
end
end
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) $ptr)->header.size
if ($size & PSEUDOVECTOR_FLAG)
@ -1034,6 +1000,12 @@ define xpr
if $vec == PVEC_NORMAL_VECTOR
xvector
end
if $vec == PVEC_MARKER
xmarker
end
if $vec == PVEC_OVERLAY
xoverlay
end
if $vec == PVEC_PROCESS
xprocess
end

7
src/Makefile.in
View file

@ -322,6 +322,9 @@ INTERVALS_H = dispextern.h intervals.h composite.h
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
GMP_LIB = @GMP_LIB@
GMP_OBJ = @GMP_OBJ@
RUN_TEMACS = ./temacs
# Whether builds should contain details. '--no-build-details' or empty.
@ -403,7 +406,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
thread.o systhread.o \
$(if $(HYBRID_MALLOC),sheap.o) \
$(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ)
$(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) $(GMP_OBJ)
obj = $(base_obj) $(NS_OBJC_OBJ)
## Object files used on some machine or other.
@ -501,7 +504,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
$(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LCMS2_LIBS) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) \
$(JSON_LIBS)
$(JSON_LIBS) $(GMP_LIB)
## FORCE it so that admin/unidata can decide whether these files
## are up-to-date. Although since charprop depends on bootstrap-emacs,

589
src/alloc.c
View file

@ -247,8 +247,8 @@ bool gc_in_progress;
/* Number of live and free conses etc. */
static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
static EMACS_INT total_conses, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_symbols;
static EMACS_INT total_free_floats, total_floats;
/* Points to memory space allocated as "spare", to be freed if we run
@ -356,6 +356,7 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size)
#endif /* MAX_SAVE_STACK > 0 */
static void unchain_finalizer (struct Lisp_Finalizer *);
static void mark_terminals (void);
static void gc_sweep (void);
static Lisp_Object make_pure_vector (ptrdiff_t);
@ -378,7 +379,6 @@ enum mem_type
MEM_TYPE_BUFFER,
MEM_TYPE_CONS,
MEM_TYPE_STRING,
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
/* Since all non-bool pseudovectors are small enough to be
@ -2321,13 +2321,13 @@ a multibyte string even if INIT is an ASCII character. */)
int c;
EMACS_INT nbytes;
CHECK_NATNUM (length);
CHECK_FIXNAT (length);
CHECK_CHARACTER (init);
c = XFASTINT (init);
c = XFIXNAT (init);
if (ASCII_CHAR_P (c) && NILP (multibyte))
{
nbytes = XINT (length);
nbytes = XFIXNUM (length);
val = make_uninit_string (nbytes);
if (nbytes)
{
@ -2339,7 +2339,7 @@ a multibyte string even if INIT is an ASCII character. */)
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
ptrdiff_t len = CHAR_STRING (c, str);
EMACS_INT string_len = XINT (length);
EMACS_INT string_len = XFIXNUM (length);
unsigned char *p, *beg, *end;
if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
@ -2415,8 +2415,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
{
Lisp_Object val;
CHECK_NATNUM (length);
val = make_uninit_bool_vector (XFASTINT (length));
CHECK_FIXNAT (length);
val = make_uninit_bool_vector (XFIXNAT (length));
return bool_vector_fill (val, init);
}
@ -2654,8 +2654,6 @@ make_float (double float_value)
if (float_free_list)
{
/* We use the data field for chaining the free list
so that we won't use the same field that has the mark bit. */
XSETFLOAT (val, float_free_list);
float_free_list = float_free_list->u.chain;
}
@ -2759,8 +2757,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
if (cons_free_list)
{
/* We use the cdr for chaining the free list
so that we won't use the same field that has the mark bit. */
XSETCONS (val, cons_free_list);
cons_free_list = cons_free_list->u.s.u.chain;
}
@ -2894,9 +2890,9 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
(Lisp_Object length, Lisp_Object init)
{
Lisp_Object val = Qnil;
CHECK_NATNUM (length);
CHECK_FIXNAT (length);
for (EMACS_INT size = XFASTINT (length); 0 < size; size--)
for (EMACS_INT size = XFIXNAT (length); 0 < size; size--)
{
val = Fcons (init, val);
rarely_quit (size);
@ -2932,7 +2928,7 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
for the most common cases; it's not required to be a power of two, but
it's expected to be a mult-of-ROUNDUP_SIZE (see below). */
#define VECTOR_BLOCK_SIZE 4096
enum { VECTOR_BLOCK_SIZE = 4096 };
/* Vector size requests are a multiple of this. */
enum { roundup_size = COMMON_MULTIPLE (LISP_ALIGNMENT, word_size) };
@ -2948,22 +2944,21 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *)))
enum {VECTOR_BLOCK_BYTES = VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *))};
/* Size of the minimal vector allocated from block. */
#define VBLOCK_BYTES_MIN vroundup_ct (header_size + sizeof (Lisp_Object))
enum { VBLOCK_BYTES_MIN = vroundup_ct (header_size + sizeof (Lisp_Object)) };
/* Size of the largest vector allocated from block. */
#define VBLOCK_BYTES_MAX \
vroundup ((VECTOR_BLOCK_BYTES / 2) - word_size)
enum { VBLOCK_BYTES_MAX = vroundup_ct ((VECTOR_BLOCK_BYTES / 2) - word_size) };
/* We maintain one free list for each possible block-allocated
vector size, and this is the number of free lists we have. */
#define VECTOR_MAX_FREE_LIST_INDEX \
((VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1)
enum { VECTOR_MAX_FREE_LIST_INDEX =
(VECTOR_BLOCK_BYTES - VBLOCK_BYTES_MIN) / roundup_size + 1 };
/* Common shortcut to advance vector pointer over a block data. */
@ -3090,14 +3085,14 @@ init_vectors (void)
/* Allocate vector from a vector block. */
static struct Lisp_Vector *
allocate_vector_from_block (size_t nbytes)
allocate_vector_from_block (ptrdiff_t nbytes)
{
struct Lisp_Vector *vector;
struct vector_block *block;
size_t index, restbytes;
eassert (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
eassert (nbytes % roundup_size == 0);
eassume (VBLOCK_BYTES_MIN <= nbytes && nbytes <= VBLOCK_BYTES_MAX);
eassume (nbytes % roundup_size == 0);
/* First, try to allocate from a free list
containing vectors of the requested size. */
@ -3182,35 +3177,63 @@ vector_nbytes (struct Lisp_Vector *v)
return vroundup (header_size + word_size * nwords);
}
/* Convert a pseudovector pointer P to its underlying struct T pointer.
Verify that the struct is small, since cleanup_vector is called
only on small vector-like objects. */
#define PSEUDOVEC_STRUCT(p, t) \
verify_expr ((header_size + VECSIZE (struct t) * word_size \
<= VBLOCK_BYTES_MAX), \
(struct t *) (p))
/* Release extra resources still in use by VECTOR, which may be any
vector-like object. */
small vector-like object. */
static void
cleanup_vector (struct Lisp_Vector *vector)
{
detect_suspicious_free (vector);
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT)
&& ((vector->header.size & PSEUDOVECTOR_SIZE_MASK)
== FONT_OBJECT_MAX))
{
struct font_driver const *drv = ((struct font *) vector)->driver;
/* The font driver might sometimes be NULL, e.g. if Emacs was
interrupted before it had time to set it up. */
if (drv)
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM))
mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value);
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER))
unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT))
{
if ((vector->header.size & PSEUDOVECTOR_SIZE_MASK) == FONT_OBJECT_MAX)
{
/* Attempt to catch subtle bugs like Bug#16140. */
eassert (valid_font_driver (drv));
drv->close ((struct font *) vector);
struct font *font = PSEUDOVEC_STRUCT (vector, font);
struct font_driver const *drv = font->driver;
/* The font driver might sometimes be NULL, e.g. if Emacs was
interrupted before it had time to set it up. */
if (drv)
{
/* Attempt to catch subtle bugs like Bug#16140. */
eassert (valid_font_driver (drv));
drv->close (font);
}
}
}
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD))
finalize_one_thread ((struct thread_state *) vector);
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_THREAD))
finalize_one_thread (PSEUDOVEC_STRUCT (vector, thread_state));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MUTEX))
finalize_one_mutex ((struct Lisp_Mutex *) vector);
finalize_one_mutex (PSEUDOVEC_STRUCT (vector, Lisp_Mutex));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_CONDVAR))
finalize_one_condvar ((struct Lisp_CondVar *) vector);
finalize_one_condvar (PSEUDOVEC_STRUCT (vector, Lisp_CondVar));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_MARKER))
{
/* sweep_buffer should already have unchained this from its buffer. */
eassert (! PSEUDOVEC_STRUCT (vector, Lisp_Marker)->buffer);
}
#ifdef HAVE_MODULES
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_USER_PTR))
{
struct Lisp_User_Ptr *uptr = PSEUDOVEC_STRUCT (vector, Lisp_User_Ptr);
if (uptr->finalizer)
uptr->finalizer (uptr->p);
}
#endif
}
/* Reclaim space used by unmarked vectors. */
@ -3439,8 +3462,8 @@ symbol or a type descriptor. SLOTS is the number of non-type slots,
each initialized to INIT. */)
(Lisp_Object type, Lisp_Object slots, Lisp_Object init)
{
CHECK_NATNUM (slots);
EMACS_INT size = XFASTINT (slots) + 1;
CHECK_FIXNAT (slots);
EMACS_INT size = XFIXNAT (slots) + 1;
struct Lisp_Vector *p = allocate_record (size);
p->contents[0] = type;
for (ptrdiff_t i = 1; i < size; i++)
@ -3468,9 +3491,9 @@ DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
See also the function `vector'. */)
(Lisp_Object length, Lisp_Object init)
{
CHECK_NATNUM (length);
struct Lisp_Vector *p = allocate_vector (XFASTINT (length));
for (ptrdiff_t i = 0; i < XFASTINT (length); i++)
CHECK_FIXNAT (length);
struct Lisp_Vector *p = allocate_vector (XFIXNAT (length));
for (ptrdiff_t i = 0; i < XFIXNAT (length); i++)
p->contents[i] = init;
return make_lisp_ptr (p, Lisp_Vectorlike);
}
@ -3641,96 +3664,27 @@ Its value is void, and its function definition and property list are nil. */)
/***********************************************************************
Marker (Misc) Allocation
***********************************************************************/
/* Like union Lisp_Misc, but padded so that its size is a multiple of
the required alignment. */
union aligned_Lisp_Misc
{
union Lisp_Misc m;
unsigned char c[(sizeof (union Lisp_Misc) + LISP_ALIGNMENT - 1)
& -LISP_ALIGNMENT];
};
/* Allocation of markers and other objects that share that structure.
Works like allocation of conses. */
#define MARKER_BLOCK_SIZE \
((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
struct marker_block
{
/* Place `markers' first, to preserve alignment. */
union aligned_Lisp_Misc markers[MARKER_BLOCK_SIZE];
struct marker_block *next;
};
static struct marker_block *marker_block;
static int marker_block_index = MARKER_BLOCK_SIZE;
static union Lisp_Misc *misc_free_list;
/* Return a newly allocated Lisp_Misc object of specified TYPE. */
static Lisp_Object
allocate_misc (enum Lisp_Misc_Type type)
{
Lisp_Object val;
MALLOC_BLOCK_INPUT;
if (misc_free_list)
{
XSETMISC (val, misc_free_list);
misc_free_list = misc_free_list->u_free.chain;
}
else
{
if (marker_block_index == MARKER_BLOCK_SIZE)
{
struct marker_block *new = lisp_malloc (sizeof *new, MEM_TYPE_MISC);
new->next = marker_block;
marker_block = new;
marker_block_index = 0;
total_free_markers += MARKER_BLOCK_SIZE;
}
XSETMISC (val, &marker_block->markers[marker_block_index].m);
marker_block_index++;
}
MALLOC_UNBLOCK_INPUT;
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
XMISCANY (val)->type = type;
XMISCANY (val)->gcmarkbit = 0;
return val;
}
Lisp_Object
make_misc_ptr (void *a)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Ptr);
XUNTAG (val, Lisp_Misc, struct Lisp_Misc_Ptr)->pointer = a;
return val;
struct Lisp_Misc_Ptr *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Misc_Ptr, pointer,
PVEC_MISC_PTR);
p->pointer = a;
return make_lisp_ptr (p, Lisp_Vectorlike);
}
/* Return a Lisp_Misc_Overlay object with specified START, END and PLIST. */
/* Return a new overlay with specified START, END and PLIST. */
Lisp_Object
build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
{
register Lisp_Object overlay;
overlay = allocate_misc (Lisp_Misc_Overlay);
struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, next,
PVEC_OVERLAY);
Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike);
OVERLAY_START (overlay) = start;
OVERLAY_END (overlay) = end;
set_overlay_plist (overlay, plist);
XOVERLAY (overlay)->next = NULL;
p->next = NULL;
return overlay;
}
@ -3738,18 +3692,15 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
doc: /* Return a newly allocated marker which does not point at any place. */)
(void)
{
register Lisp_Object val;
register struct Lisp_Marker *p;
val = allocate_misc (Lisp_Misc_Marker);
p = XMARKER (val);
struct Lisp_Marker *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer,
PVEC_MARKER);
p->buffer = 0;
p->bytepos = 0;
p->charpos = 0;
p->next = NULL;
p->insertion_type = 0;
p->need_adjustment = 0;
return val;
return make_lisp_ptr (p, Lisp_Vectorlike);
}
/* Return a newly allocated marker which points into BUF
@ -3758,17 +3709,14 @@ DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
Lisp_Object
build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
{
Lisp_Object obj;
struct Lisp_Marker *m;
/* No dead buffers here. */
eassert (BUFFER_LIVE_P (buf));
/* Every character is at least one byte. */
eassert (charpos <= bytepos);
obj = allocate_misc (Lisp_Misc_Marker);
m = XMARKER (obj);
struct Lisp_Marker *m = ALLOCATE_PSEUDOVECTOR (struct Lisp_Marker, buffer,
PVEC_MARKER);
m->buffer = buf;
m->charpos = charpos;
m->bytepos = bytepos;
@ -3776,7 +3724,86 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
m->need_adjustment = 0;
m->next = BUF_MARKERS (buf);
BUF_MARKERS (buf) = m;
return obj;
return make_lisp_ptr (m, Lisp_Vectorlike);
}
Lisp_Object
make_bignum_str (const char *num, int base)
{
struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
PVEC_BIGNUM);
mpz_init (b->value);
int check = mpz_set_str (b->value, num, base);
eassert (check == 0);
return make_lisp_ptr (b, Lisp_Vectorlike);
}
/* Given an mpz_t, make a number. This may return a bignum or a
fixnum depending on VALUE. */
Lisp_Object
make_number (mpz_t value)
{
if (mpz_fits_slong_p (value))
{
long l = mpz_get_si (value);
if (!FIXNUM_OVERFLOW_P (l))
return make_fixnum (l);
}
/* Check if fixnum can be larger than long. */
if (sizeof (EMACS_INT) > sizeof (long))
{
size_t bits = mpz_sizeinbase (value, 2);
int sign = mpz_sgn (value);
if (bits < FIXNUM_BITS + (sign < 0))
{
EMACS_INT v = 0;
size_t limbs = mpz_size (value);
mp_size_t i;
for (i = 0; i < limbs; i++)
{
mp_limb_t limb = mpz_getlimbn (value, i);
v |= (EMACS_INT) ((EMACS_UINT) limb << (i * mp_bits_per_limb));
}
if (sign < 0)
v = -v;
if (!FIXNUM_OVERFLOW_P (v))
return make_fixnum (v);
}
}
struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
PVEC_BIGNUM);
/* We could mpz_init + mpz_swap here, to avoid a copy, but the
resulting API seemed possibly confusing. */
mpz_init_set (b->value, value);
return make_lisp_ptr (b, Lisp_Vectorlike);
}
void
mpz_set_intmax_slow (mpz_t result, intmax_t v)
{
/* If long is larger then a faster path is taken. */
eassert (sizeof (intmax_t) > sizeof (long));
bool complement = v < 0;
if (complement)
v = -1 - v;
/* COUNT = 1 means just a single word of the given size. ORDER = -1
is arbitrary since there's only a single word. ENDIAN = 0 means
use the native endian-ness. NAILS = 0 means use the whole
word. */
mpz_import (result, 1, -1, sizeof v, 0, 0, &v);
if (complement)
mpz_com (result, result);
}
@ -3795,8 +3822,8 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
/* The things that fit in a string
are characters that are in 0...127,
after discarding the meta bit and all the bits above it. */
if (!INTEGERP (args[i])
|| (XINT (args[i]) & ~(-CHAR_META)) >= 0200)
if (!FIXNUMP (args[i])
|| (XFIXNUM (args[i]) & ~(-CHAR_META)) >= 0200)
return Fvector (nargs, args);
/* Since the loop exited, we know that all the things in it are
@ -3804,12 +3831,12 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object result;
result = Fmake_string (make_number (nargs), make_number (0), Qnil);
result = Fmake_string (make_fixnum (nargs), make_fixnum (0), Qnil);
for (i = 0; i < nargs; i++)
{
SSET (result, i, XINT (args[i]));
SSET (result, i, XFIXNUM (args[i]));
/* Move the meta bit to the right place for a string char. */
if (XINT (args[i]) & CHAR_META)
if (XFIXNUM (args[i]) & CHAR_META)
SSET (result, i, SREF (result, i) | 0x80);
}
@ -3822,14 +3849,11 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
Lisp_Object
make_user_ptr (void (*finalizer) (void *), void *p)
{
Lisp_Object obj;
struct Lisp_User_Ptr *uptr;
obj = allocate_misc (Lisp_Misc_User_Ptr);
uptr = XUSER_PTR (obj);
struct Lisp_User_Ptr *uptr = ALLOCATE_PSEUDOVECTOR (struct Lisp_User_Ptr,
finalizer, PVEC_USER_PTR);
uptr->finalizer = finalizer;
uptr->p = p;
return obj;
return make_lisp_ptr (uptr, Lisp_Vectorlike);
}
#endif
@ -3872,7 +3896,7 @@ mark_finalizer_list (struct Lisp_Finalizer *head)
finalizer != head;
finalizer = finalizer->next)
{
finalizer->base.gcmarkbit = true;
VECTOR_MARK (finalizer);
mark_object (finalizer->function);
}
}
@ -3889,7 +3913,7 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest,
while (finalizer != src)
{
struct Lisp_Finalizer *next = finalizer->next;
if (!finalizer->base.gcmarkbit && !NILP (finalizer->function))
if (!VECTOR_MARKED_P (finalizer) && !NILP (finalizer->function))
{
unchain_finalizer (finalizer);
finalizer_insert (dest, finalizer);
@ -3925,7 +3949,6 @@ run_finalizers (struct Lisp_Finalizer *finalizers)
while (finalizers->next != finalizers)
{
finalizer = finalizers->next;
eassert (finalizer->base.type == Lisp_Misc_Finalizer);
unchain_finalizer (finalizer);
function = finalizer->function;
if (!NILP (function))
@ -3945,12 +3968,12 @@ count as reachable for the purpose of deciding whether to run
FUNCTION. FUNCTION will be run once per finalizer object. */)
(Lisp_Object function)
{
Lisp_Object val = allocate_misc (Lisp_Misc_Finalizer);
struct Lisp_Finalizer *finalizer = XFINALIZER (val);
struct Lisp_Finalizer *finalizer
= ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, prev, PVEC_FINALIZER);
finalizer->function = function;
finalizer->prev = finalizer->next = NULL;
finalizer_insert (&finalizers, finalizer);
return val;
return make_lisp_ptr (finalizer, Lisp_Vectorlike);
}
@ -4571,41 +4594,6 @@ live_float_p (struct mem_node *m, void *p)
return 0;
}
/* If P is a pointer to a live Lisp Misc on the heap, return the object.
Otherwise, return nil. M is a pointer to the mem_block for P. */
static Lisp_Object
live_misc_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
{
struct marker_block *b = m->start;
char *cp = p;
ptrdiff_t offset = cp - (char *) &b->markers[0];
/* P must point into a Lisp_Misc, not be
one of the unused cells in the current misc block,
and not be on the free-list. */
if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0]
&& (b != marker_block
|| offset / sizeof b->markers[0] < marker_block_index))
{
cp = ptr_bounds_copy (cp, b);
union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0];
if (s->u_any.type != Lisp_Misc_Free)
return make_lisp_ptr (s, Lisp_Misc);
}
}
return Qnil;
}
static bool
live_misc_p (struct mem_node *m, void *p)
{
return !NILP (live_misc_holding (m, p));
}
/* If P is a pointer to a live vector-like object, return the object.
Otherwise, return nil.
M is a pointer to the mem_block for P. */
@ -4691,7 +4679,7 @@ mark_maybe_object (Lisp_Object obj)
VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
#endif
if (INTEGERP (obj))
if (FIXNUMP (obj))
return;
void *po = XPNTR (obj);
@ -4724,10 +4712,6 @@ mark_maybe_object (Lisp_Object obj)
|| EQ (obj, live_buffer_holding (m, po)));
break;
case Lisp_Misc:
mark_p = EQ (obj, live_misc_holding (m, po));
break;
default:
break;
}
@ -4809,10 +4793,6 @@ mark_maybe_pointer (void *p)
obj = live_string_holding (m, p);
break;
case MEM_TYPE_MISC:
obj = live_misc_holding (m, p);
break;
case MEM_TYPE_SYMBOL:
obj = live_symbol_holding (m, p);
break;
@ -5171,7 +5151,7 @@ valid_pointer_p (void *p)
int
valid_lisp_object_p (Lisp_Object obj)
{
if (INTEGERP (obj))
if (FIXNUMP (obj))
return 1;
void *p = XPNTR (obj);
@ -5213,9 +5193,6 @@ valid_lisp_object_p (Lisp_Object obj)
case MEM_TYPE_STRING:
return live_string_p (m, p);
case MEM_TYPE_MISC:
return live_misc_p (m, p);
case MEM_TYPE_SYMBOL:
return live_symbol_p (m, p);
@ -5432,6 +5409,32 @@ make_pure_float (double num)
return new;
}
/* Value is a bignum object with value VALUE allocated from pure
space. */
static Lisp_Object
make_pure_bignum (struct Lisp_Bignum *value)
{
size_t i, nlimbs = mpz_size (value->value);
size_t nbytes = nlimbs * sizeof (mp_limb_t);
mp_limb_t *pure_limbs;
mp_size_t new_size;
struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike);
XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum));
pure_limbs = pure_alloc (nbytes, -1);
for (i = 0; i < nlimbs; ++i)
pure_limbs[i] = mpz_getlimbn (value->value, i);
new_size = nlimbs;
if (mpz_sgn (value->value) < 0)
new_size = -new_size;
mpz_roinit_n (b->value, pure_limbs, new_size);
return make_lisp_ptr (b, Lisp_Vectorlike);
}
/* Return a vector with room for LEN Lisp_Objects allocated from
pure space. */
@ -5504,7 +5507,7 @@ static struct pinned_object
static Lisp_Object
purecopy (Lisp_Object obj)
{
if (INTEGERP (obj)
if (FIXNUMP (obj)
|| (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
|| SUBRP (obj))
return obj; /* Already pure. */
@ -5573,6 +5576,8 @@ purecopy (Lisp_Object obj)
/* Don't hash-cons it. */
return obj;
}
else if (BIGNUMP (obj))
obj = make_pure_bignum (XBIGNUM (obj));
else
{
AUTO_STRING (fmt, "Don't know how to purify: %S");
@ -5614,7 +5619,7 @@ inhibit_garbage_collection (void)
{
ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
specbind (Qgc_cons_threshold, make_fixnum (MOST_POSITIVE_FIXNUM));
return count;
}
@ -5624,7 +5629,7 @@ inhibit_garbage_collection (void)
static Lisp_Object
bounded_number (EMACS_INT number)
{
return make_number (min (MOST_POSITIVE_FIXNUM, number));
return make_fixnum (min (MOST_POSITIVE_FIXNUM, number));
}
/* Calculate total bytes of live objects. */
@ -5635,7 +5640,6 @@ total_bytes_of_live_objects (void)
size_t tot = 0;
tot += total_conses * sizeof (struct Lisp_Cons);
tot += total_symbols * sizeof (struct Lisp_Symbol);
tot += total_markers * sizeof (union Lisp_Misc);
tot += total_string_bytes;
tot += total_vector_slots * word_size;
tot += total_floats * sizeof (struct Lisp_Float);
@ -5756,7 +5760,7 @@ compact_undo_list (Lisp_Object list)
{
if (CONSP (XCAR (tail))
&& MARKERP (XCAR (XCAR (tail)))
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
&& !VECTOR_MARKED_P (XMARKER (XCAR (XCAR (tail)))))
*prev = XCDR (tail);
else
prev = xcdr_addr (tail);
@ -5977,37 +5981,34 @@ garbage_collect_1 (void *end)
unbind_to (count, Qnil);
Lisp_Object total[] = {
list4 (Qconses, make_number (sizeof (struct Lisp_Cons)),
list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
bounded_number (total_conses),
bounded_number (total_free_conses)),
list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)),
list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)),
bounded_number (total_symbols),
bounded_number (total_free_symbols)),
list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)),
bounded_number (total_markers),
bounded_number (total_free_markers)),
list4 (Qstrings, make_number (sizeof (struct Lisp_String)),
list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)),
bounded_number (total_strings),
bounded_number (total_free_strings)),
list3 (Qstring_bytes, make_number (1),
list3 (Qstring_bytes, make_fixnum (1),
bounded_number (total_string_bytes)),
list3 (Qvectors,
make_number (header_size + sizeof (Lisp_Object)),
make_fixnum (header_size + sizeof (Lisp_Object)),
bounded_number (total_vectors)),
list4 (Qvector_slots, make_number (word_size),
list4 (Qvector_slots, make_fixnum (word_size),
bounded_number (total_vector_slots),
bounded_number (total_free_vector_slots)),
list4 (Qfloats, make_number (sizeof (struct Lisp_Float)),
list4 (Qfloats, make_fixnum (sizeof (struct Lisp_Float)),
bounded_number (total_floats),
bounded_number (total_free_floats)),
list4 (Qintervals, make_number (sizeof (struct interval)),
list4 (Qintervals, make_fixnum (sizeof (struct interval)),
bounded_number (total_intervals),
bounded_number (total_free_intervals)),
list3 (Qbuffers, make_number (sizeof (struct buffer)),
list3 (Qbuffers, make_fixnum (sizeof (struct buffer)),
bounded_number (total_buffers)),
#ifdef DOUG_LEA_MALLOC
list4 (Qheap, make_number (1024),
list4 (Qheap, make_fixnum (1024),
bounded_number ((mallinfo ().uordblks + 1023) >> 10),
bounded_number ((mallinfo ().fordblks + 1023) >> 10)),
#endif
@ -6142,7 +6143,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
{
Lisp_Object val = ptr->contents[i];
if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
if (FIXNUMP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
continue;
if (SUB_CHAR_TABLE_P (val))
{
@ -6172,12 +6173,12 @@ mark_compiled (struct Lisp_Vector *ptr)
static void
mark_overlay (struct Lisp_Overlay *ptr)
{
for (; ptr && !ptr->gcmarkbit; ptr = ptr->next)
for (; ptr && !VECTOR_MARKED_P (ptr); ptr = ptr->next)
{
ptr->gcmarkbit = 1;
VECTOR_MARK (ptr);
/* These two are always markers and can be marked fast. */
XMARKER (ptr->start)->gcmarkbit = 1;
XMARKER (ptr->end)->gcmarkbit = 1;
VECTOR_MARK (XMARKER (ptr->start));
VECTOR_MARK (XMARKER (ptr->end));
mark_object (ptr->plist);
}
}
@ -6478,9 +6479,8 @@ mark_object (Lisp_Object arg)
mark_char_table (ptr, (enum pvec_type) pvectype);
break;
case PVEC_BOOL_VECTOR:
/* No Lisp_Objects to mark in a bool vector. */
VECTOR_MARK (ptr);
case PVEC_OVERLAY:
mark_overlay (XOVERLAY (obj));
break;
case PVEC_SUBR:
@ -6490,6 +6490,8 @@ mark_object (Lisp_Object arg)
emacs_abort ();
default:
/* A regular vector, or a pseudovector needing no special
treatment. */
mark_vectorlike (ptr);
}
}
@ -6538,48 +6540,9 @@ mark_object (Lisp_Object arg)
}
break;
case Lisp_Misc:
CHECK_ALLOCATED_AND_LIVE (live_misc_p);
if (XMISCANY (obj)->gcmarkbit)
break;
switch (XMISCTYPE (obj))
{
case Lisp_Misc_Marker:
/* DO NOT mark thru the marker's chain.
The buffer's markers chain does not preserve markers from gc;
instead, markers are removed from the chain when freed by gc. */
XMISCANY (obj)->gcmarkbit = 1;
break;
case Lisp_Misc_Ptr:
XMISCANY (obj)->gcmarkbit = true;
break;
case Lisp_Misc_Overlay:
mark_overlay (XOVERLAY (obj));
break;
case Lisp_Misc_Finalizer:
XMISCANY (obj)->gcmarkbit = true;
mark_object (XFINALIZER (obj)->function);
break;
#ifdef HAVE_MODULES
case Lisp_Misc_User_Ptr:
XMISCANY (obj)->gcmarkbit = true;
break;
#endif
default:
emacs_abort ();
}
break;
case Lisp_Cons:
{
register struct Lisp_Cons *ptr = XCONS (obj);
struct Lisp_Cons *ptr = XCONS (obj);
if (CONS_MARKED_P (ptr))
break;
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
@ -6656,10 +6619,6 @@ survives_gc_p (Lisp_Object obj)
survives_p = XSYMBOL (obj)->u.s.gcmarkbit;
break;
case Lisp_Misc:
survives_p = XMISCANY (obj)->gcmarkbit;
break;
case Lisp_String:
survives_p = STRING_MARKED_P (XSTRING (obj));
break;
@ -6936,79 +6895,6 @@ sweep_symbols (void)
total_free_symbols = num_free;
}
NO_INLINE /* For better stack traces. */
static void
sweep_misc (void)
{
register struct marker_block *mblk;
struct marker_block **mprev = &marker_block;
register int lim = marker_block_index;
EMACS_INT num_free = 0, num_used = 0;
/* Put all unmarked misc's on free list. For a marker, first
unchain it from the buffer it points into. */
misc_free_list = 0;
for (mblk = marker_block; mblk; mblk = *mprev)
{
register int i;
int this_free = 0;
for (i = 0; i < lim; i++)
{
if (!mblk->markers[i].m.u_any.gcmarkbit)
{
if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
/* Make sure markers have been unchained from their buffer
in sweep_buffer before we collect them. */
eassert (!mblk->markers[i].m.u_marker.buffer);
else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
unchain_finalizer (&mblk->markers[i].m.u_finalizer);
#ifdef HAVE_MODULES
else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
{
struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
if (uptr->finalizer)
uptr->finalizer (uptr->p);
}
#endif
/* Set the type of the freed object to Lisp_Misc_Free.
We could leave the type alone, since nobody checks it,
but this might catch bugs faster. */
mblk->markers[i].m.u_marker.type = Lisp_Misc_Free;
mblk->markers[i].m.u_free.chain = misc_free_list;
misc_free_list = &mblk->markers[i].m;
this_free++;
}
else
{
num_used++;
mblk->markers[i].m.u_any.gcmarkbit = 0;
}
}
lim = MARKER_BLOCK_SIZE;
/* If this block contains only free markers and we have already
seen more than two blocks worth of free markers then deallocate
this block. */
if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
{
*mprev = mblk->next;
/* Unhook from the free list. */
misc_free_list = mblk->markers[0].m.u_free.chain;
lisp_free (mblk);
}
else
{
num_free += this_free;
mprev = &mblk->next;
}
}
total_markers = num_used;
total_free_markers = num_free;
}
/* Remove BUFFER's markers that are due to be swept. This is needed since
we treat BUF_MARKERS and markers's `next' field as weak pointers. */
static void
@ -7017,7 +6903,7 @@ unchain_dead_markers (struct buffer *buffer)
struct Lisp_Marker *this, **prev = &BUF_MARKERS (buffer);
while ((this = *prev))
if (this->gcmarkbit)
if (VECTOR_MARKED_P (this))
prev = &this->next;
else
{
@ -7065,7 +6951,6 @@ gc_sweep (void)
sweep_intervals ();
sweep_symbols ();
sweep_buffers ();
sweep_misc ();
sweep_vectors ();
check_string_bytes (!noninteractive);
}
@ -7126,11 +7011,10 @@ Each of these counters increments for a certain kind of object.
The counters wrap around from the largest positive integer to zero.
Garbage collection does not decrease them.
The elements of the value are as follows:
(CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)
(CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS INTERVALS STRINGS)
All are in units of 1 = one object consed
except for VECTOR-CELLS and STRING-CHARS, which count the total length of
objects consed.
MISCS include overlays, markers, and some internal types.
Frames, windows, buffers, and subprocesses count as vectors
(but the contents of a buffer's text do not count here). */)
(void)
@ -7141,7 +7025,6 @@ Frames, windows, buffers, and subprocesses count as vectors
bounded_number (vector_cells_consed),
bounded_number (symbols_consed),
bounded_number (string_chars_consed),
bounded_number (misc_objects_consed),
bounded_number (intervals_consed),
bounded_number (strings_consed));
}
@ -7400,11 +7283,6 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
DEFVAR_INT ("string-chars-consed", string_chars_consed,
doc: /* Number of string characters that have been consed so far. */);
DEFVAR_INT ("misc-objects-consed", misc_objects_consed,
doc: /* Number of miscellaneous objects that have been consed so far.
These include markers and overlays, plus certain objects not visible
to users. */);
DEFVAR_INT ("intervals-consed", intervals_consed,
doc: /* Number of intervals that have been consed so far. */);
@ -7440,7 +7318,6 @@ do hash-consing of the objects allocated to pure space. */);
DEFSYM (Qconses, "conses");
DEFSYM (Qsymbols, "symbols");
DEFSYM (Qmiscs, "miscs");
DEFSYM (Qstrings, "strings");
DEFSYM (Qvectors, "vectors");
DEFSYM (Qfloats, "floats");

12
src/bidi.c
View file

@ -280,7 +280,7 @@ bidi_get_type (int ch, bidi_dir_t override)
if (ch < 0 || ch > MAX_CHAR)
emacs_abort ();
default_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
default_type = (bidi_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_type_table, ch));
/* Every valid character code, even those that are unassigned by the
UCD, have some bidi-class property, according to
DerivedBidiClass.txt file. Therefore, if we ever get UNKNOWN_BT
@ -379,15 +379,15 @@ bidi_mirror_char (int c)
emacs_abort ();
val = CHAR_TABLE_REF (bidi_mirror_table, c);
if (INTEGERP (val))
if (FIXNUMP (val))
{
int v;
/* When debugging, check before assigning to V, so that the check
isn't broken by undefined behavior due to int overflow. */
eassert (CHAR_VALID_P (XINT (val)));
eassert (CHAR_VALID_P (XFIXNUM (val)));
v = XINT (val);
v = XFIXNUM (val);
/* Minimal test we must do in optimized builds, to prevent weird
crashes further down the road. */
@ -409,7 +409,7 @@ bidi_paired_bracket_type (int c)
if (c < 0 || c > MAX_CHAR)
emacs_abort ();
return (bidi_bracket_type_t) XINT (CHAR_TABLE_REF (bidi_brackets_table, c));
return (bidi_bracket_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_brackets_table, c));
}
/* Determine the start-of-sequence (sos) directional type given the two
@ -1805,7 +1805,7 @@ bidi_explicit_dir_char (int ch)
eassert (ch == BIDI_EOB);
return false;
}
ch_type = (bidi_type_t) XINT (CHAR_TABLE_REF (bidi_type_table, ch));
ch_type = (bidi_type_t) XFIXNUM (CHAR_TABLE_REF (bidi_type_table, ch));
return (ch_type == LRE || ch_type == LRO
|| ch_type == RLE || ch_type == RLO
|| ch_type == PDF);

454
src/buffer.c
View file

File diff suppressed because it is too large Load diff

8
src/buffer.h
View file

@ -295,7 +295,7 @@ extern void enlarge_buffer_text (struct buffer *, ptrdiff_t);
do \
{ \
Lisp_Object __pos = (pos); \
if (NUMBERP (__pos)) \
if (FIXED_OR_FLOATP (__pos)) \
{ \
charpos = __pos; \
bytepos = buf_charpos_to_bytepos (current_buffer, __pos); \
@ -1349,7 +1349,7 @@ extern int last_per_buffer_idx;
#define PER_BUFFER_IDX(OFFSET) \
XINT (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
XFIXNUM (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_flags))
/* Functions to get and set default value of the per-buffer
variable at offset OFFSET in the buffer structure. */
@ -1387,7 +1387,7 @@ downcase (int c)
{
Lisp_Object downcase_table = BVAR (current_buffer, downcase_table);
Lisp_Object down = CHAR_TABLE_REF (downcase_table, c);
return NATNUMP (down) ? XFASTINT (down) : c;
return FIXNATP (down) ? XFIXNAT (down) : c;
}
/* Upcase a character C, or make no change if that cannot be done. */
@ -1396,7 +1396,7 @@ upcase (int c)
{
Lisp_Object upcase_table = BVAR (current_buffer, upcase_table);
Lisp_Object up = CHAR_TABLE_REF (upcase_table, c);
return NATNUMP (up) ? XFASTINT (up) : c;
return FIXNATP (up) ? XFIXNAT (up) : c;
}
/* True if C is upper case. */

76
src/bytecode.c
View file

@ -63,14 +63,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
{ \
if (byte_metering_on) \
{ \
if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \
if (XFIXNAT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM) \
XSETFASTINT (METER_1 (this_code), \
XFASTINT (METER_1 (this_code)) + 1); \
XFIXNAT (METER_1 (this_code)) + 1); \
if (last_code \
&& (XFASTINT (METER_2 (last_code, this_code)) \
&& (XFIXNAT (METER_2 (last_code, this_code)) \
< MOST_POSITIVE_FIXNUM)) \
XSETFASTINT (METER_2 (last_code, this_code), \
XFASTINT (METER_2 (last_code, this_code)) + 1); \
XFIXNAT (METER_2 (last_code, this_code)) + 1); \
} \
}
@ -346,7 +346,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CHECK_STRING (bytestr);
CHECK_VECTOR (vector);
CHECK_NATNUM (maxdepth);
CHECK_FIXNAT (maxdepth);
ptrdiff_t const_length = ASIZE (vector);
@ -362,7 +362,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object *vectorp = XVECTOR (vector)->contents;
unsigned char quitcounter = 1;
EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
EMACS_INT stack_items = XFIXNAT (maxdepth) + 1;
USE_SAFE_ALLOCA;
void *alloc;
SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length);
@ -378,16 +378,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (!NILP (args_template))
{
eassert (INTEGERP (args_template));
ptrdiff_t at = XINT (args_template);
eassert (FIXNUMP (args_template));
ptrdiff_t at = XFIXNUM (args_template);
bool rest = (at & 128) != 0;
int mandatory = at & 127;
ptrdiff_t nonrest = at >> 8;
ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
if (! (mandatory <= nargs && nargs <= maxargs))
Fsignal (Qwrong_number_of_arguments,
list2 (Fcons (make_number (mandatory), make_number (nonrest)),
make_number (nargs)));
list2 (Fcons (make_fixnum (mandatory), make_fixnum (nonrest)),
make_fixnum (nargs)));
ptrdiff_t pushedargs = min (nonrest, nargs);
for (ptrdiff_t i = 0; i < pushedargs; i++, args++)
PUSH (*args);
@ -621,10 +621,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
Lisp_Object v1 = TOP;
Lisp_Object v2 = Fget (v1, Qbyte_code_meter);
if (INTEGERP (v2)
&& XINT (v2) < MOST_POSITIVE_FIXNUM)
if (FIXNUMP (v2)
&& XFIXNUM (v2) < MOST_POSITIVE_FIXNUM)
{
XSETINT (v2, XINT (v2) + 1);
XSETINT (v2, XFIXNUM (v2) + 1);
Fput (v1, Qbyte_code_meter, v2);
}
}
@ -832,8 +832,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bnth):
{
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v1);
for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
CHECK_FIXNUM (v1);
for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
{
v2 = XCDR (v2);
rarely_quit (n);
@ -972,11 +972,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bsub1):
TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP);
TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
? make_fixnum (XFIXNUM (TOP) - 1)
: Fsub1 (TOP));
NEXT;
CASE (Badd1):
TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP);
TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM
? make_fixnum (XFIXNUM (TOP) + 1)
: Fadd1 (TOP));
NEXT;
CASE (Beqlsign):
@ -986,8 +990,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
TOP = arithcompare (v1, v2, ARITH_EQUAL);
else
{
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1);
CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2);
TOP = EQ (v1, v2) ? Qt : Qnil;
}
NEXT;
@ -1027,7 +1031,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bnegate):
TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP);
TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
? make_fixnum (- XFIXNUM (TOP))
: Fminus (1, &TOP));
NEXT;
CASE (Bplus):
@ -1063,7 +1069,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Bpoint):
PUSH (make_natnum (PT));
PUSH (make_fixed_natnum (PT));
NEXT;
CASE (Bgoto_char):
@ -1089,7 +1095,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
}
CASE (Bpoint_min):
PUSH (make_natnum (BEGV));
PUSH (make_fixed_natnum (BEGV));
NEXT;
CASE (Bchar_after):
@ -1105,7 +1111,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bcurrent_column):
PUSH (make_natnum (current_column ()));
PUSH (make_fixed_natnum (current_column ()));
NEXT;
CASE (Bindent_to):
@ -1169,7 +1175,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
CASE (Bchar_syntax):
{
CHECK_CHARACTER (TOP);
int c = XFASTINT (TOP);
int c = XFIXNAT (TOP);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
MAKE_CHAR_MULTIBYTE (c);
XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
@ -1262,8 +1268,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
/* Exchange args and then do nth. */
Lisp_Object v2 = POP, v1 = TOP;
CHECK_NUMBER (v2);
for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
CHECK_FIXNUM (v2);
for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--)
{
v1 = XCDR (v1);
rarely_quit (n);
@ -1415,7 +1421,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{ /* Do a linear search if there are not many cases
FIXME: 5 is arbitrarily chosen. */
Lisp_Object hash_code = h->test.cmpfn
? make_number (h->test.hashfn (&h->test, v1)) : Qnil;
? make_fixnum (h->test.hashfn (&h->test, v1)) : Qnil;
for (i = h->count; 0 <= --i; )
if (EQ (v1, HASH_KEY (h, i))
@ -1431,9 +1437,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
if (i >= 0)
{
Lisp_Object val = HASH_VALUE (h, i);
if (BYTE_CODE_SAFE && !INTEGERP (val))
if (BYTE_CODE_SAFE && !FIXNUMP (val))
emacs_abort ();
op = XINT (val);
op = XFIXNUM (val);
goto op_branch;
}
}
@ -1468,14 +1474,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
Lisp_Object
get_byte_code_arity (Lisp_Object args_template)
{
eassert (NATNUMP (args_template));
EMACS_INT at = XINT (args_template);
eassert (FIXNATP (args_template));
EMACS_INT at = XFIXNUM (args_template);
bool rest = (at & 128) != 0;
int mandatory = at & 127;
EMACS_INT nonrest = at >> 8;
return Fcons (make_number (mandatory),
rest ? Qmany : make_number (nonrest));
return Fcons (make_fixnum (mandatory),
rest ? Qmany : make_fixnum (nonrest));
}
void
@ -1500,13 +1506,13 @@ If a symbol has a property named `byte-code-meter' whose value is an
integer, it is incremented each time that symbol's function is called. */);
byte_metering_on = false;
Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
Vbyte_code_meter = Fmake_vector (make_fixnum (256), make_fixnum (0));
DEFSYM (Qbyte_code_meter, "byte-code-meter");
{
int i = 256;
while (i--)
ASET (Vbyte_code_meter, i,
Fmake_vector (make_number (256), make_number (0)));
Fmake_vector (make_fixnum (256), make_fixnum (0)));
}
#endif
}

28
src/callint.c
View file

@ -200,8 +200,8 @@ fix_command (Lisp_Object input, Lisp_Object values)
carelt = XCAR (elt);
/* If it is (if X Y), look at Y. */
if (EQ (carelt, Qif)
&& NILP (Fnthcdr (make_number (3), elt)))
elt = Fnth (make_number (2), elt);
&& NILP (Fnthcdr (make_fixnum (3), elt)))
elt = Fnth (make_fixnum (2), elt);
/* If it is (when ... Y), look at Y. */
else if (EQ (carelt, Qwhen))
{
@ -479,8 +479,8 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'c': /* Character. */
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
make_number (SCHARS (callint_message)),
Fput_text_property (make_fixnum (0),
make_fixnum (SCHARS (callint_message)),
Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_char (callint_message, Qnil, Qnil);
message1_nolog (0);
@ -531,8 +531,8 @@ invoke it. If KEYS is omitted or nil, the return value of
ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
make_number (SCHARS (callint_message)),
Fput_text_property (make_fixnum (0),
make_fixnum (SCHARS (callint_message)),
Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_key_sequence (callint_message,
Qnil, Qnil, Qnil, Qnil);
@ -542,7 +542,7 @@ invoke it. If KEYS is omitted or nil, the return value of
/* If the key sequence ends with a down-event,
discard the following up-event. */
Lisp_Object teml
= Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
= Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1));
if (CONSP (teml))
teml = XCAR (teml);
if (SYMBOLP (teml))
@ -561,8 +561,8 @@ invoke it. If KEYS is omitted or nil, the return value of
ptrdiff_t speccount1 = SPECPDL_INDEX ();
specbind (Qcursor_in_echo_area, Qt);
/* Prompt in `minibuffer-prompt' face. */
Fput_text_property (make_number (0),
make_number (SCHARS (callint_message)),
Fput_text_property (make_fixnum (0),
make_fixnum (SCHARS (callint_message)),
Qface, Qminibuffer_prompt, callint_message);
args[i] = Fread_key_sequence_vector (callint_message,
Qnil, Qt, Qnil, Qnil);
@ -572,7 +572,7 @@ invoke it. If KEYS is omitted or nil, the return value of
/* If the key sequence ends with a down-event,
discard the following up-event. */
Lisp_Object teml
= Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
= Faref (args[i], make_fixnum (XFIXNUM (Flength (args[i])) - 1));
if (CONSP (teml))
teml = XCAR (teml);
if (SYMBOLP (teml))
@ -589,7 +589,7 @@ invoke it. If KEYS is omitted or nil, the return value of
case 'U': /* Up event from last k or K. */
if (!NILP (up_event))
{
args[i] = Fmake_vector (make_number (1), up_event);
args[i] = Fmake_vector (make_fixnum (1), up_event);
up_event = Qnil;
visargs[i] = Fkey_description (args[i], Qnil);
}
@ -795,9 +795,9 @@ Its numeric meaning is what you would get from `(interactive "p")'. */)
XSETFASTINT (val, 1);
else if (EQ (raw, Qminus))
XSETINT (val, -1);
else if (CONSP (raw) && INTEGERP (XCAR (raw)))
XSETINT (val, XINT (XCAR (raw)));
else if (INTEGERP (raw))
else if (CONSP (raw) && FIXNUMP (XCAR (raw)))
XSETINT (val, XFIXNUM (XCAR (raw)));
else if (FIXNUMP (raw))
val = raw;
else
XSETFASTINT (val, 1);

24
src/callproc.c
View file

@ -83,7 +83,7 @@ static pid_t synch_process_pid;
#ifdef MSDOS
static Lisp_Object synch_process_tempfile;
#else
# define synch_process_tempfile make_number (0)
# define synch_process_tempfile make_fixnum (0)
#endif
/* Indexes of file descriptors that need closing on call_process_kill. */
@ -324,7 +324,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
#ifndef subprocesses
/* Without asynchronous processes we cannot have BUFFER == 0. */
if (nargs >= 3
&& (INTEGERP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
&& (FIXNUMP (CONSP (args[2]) ? XCAR (args[2]) : args[2])))
error ("Operating system cannot handle asynchronous subprocesses");
#endif /* subprocesses */
@ -403,7 +403,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
buffer = Qnil;
}
if (! (NILP (buffer) || EQ (buffer, Qt) || INTEGERP (buffer)))
if (! (NILP (buffer) || EQ (buffer, Qt) || FIXNUMP (buffer)))
{
Lisp_Object spec_buffer;
spec_buffer = buffer;
@ -431,7 +431,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
for (i = 0; i < CALLPROC_FDS; i++)
callproc_fd[i] = -1;
#ifdef MSDOS
synch_process_tempfile = make_number (0);
synch_process_tempfile = make_fixnum (0);
#endif
record_unwind_protect_ptr (call_process_kill, callproc_fd);
@ -440,7 +440,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
int ok;
ok = openp (Vexec_path, args[0], Vexec_suffixes, &path,
make_number (X_OK), false);
make_fixnum (X_OK), false);
if (ok < 0)
report_file_error ("Searching for program", args[0]);
}
@ -471,7 +471,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
path = ENCODE_FILE (path);
new_argv[0] = SSDATA (path);
discard_output = INTEGERP (buffer) || (NILP (buffer) && NILP (output_file));
discard_output = FIXNUMP (buffer) || (NILP (buffer) && NILP (output_file));
#ifdef MSDOS
if (! discard_output && ! STRINGP (output_file))
@ -670,7 +670,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
{
synch_process_pid = pid;
if (INTEGERP (buffer))
if (FIXNUMP (buffer))
{
if (tempfile_index < 0)
record_deleted_pid (pid, Qnil);
@ -703,7 +703,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
#endif /* not MSDOS */
if (INTEGERP (buffer))
if (FIXNUMP (buffer))
return unbind_to (count, Qnil);
if (BUFFERP (buffer))
@ -870,7 +870,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
coding-system used to decode the process output. */
if (inherit_process_coding_system)
call1 (intern ("after-insert-file-set-buffer-file-coding-system"),
make_number (total_read));
make_fixnum (total_read));
}
bool wait_ok = true;
@ -903,7 +903,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
}
eassert (WIFEXITED (status));
return make_number (WEXITSTATUS (status));
return make_fixnum (WEXITSTATUS (status));
}
/* Create a temporary file suitable for storing the input data of
@ -1066,7 +1066,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r
validate_region (&args[0], &args[1]);
start = args[0];
end = args[1];
empty_input = XINT (start) == XINT (end);
empty_input = XFIXNUM (start) == XFIXNUM (end);
}
if (!empty_input)
@ -1644,7 +1644,7 @@ syms_of_callproc (void)
staticpro (&Vtemp_file_name_pattern);
#ifdef MSDOS
synch_process_tempfile = make_number (0);
synch_process_tempfile = make_fixnum (0);
staticpro (&synch_process_tempfile);
#endif

20
src/casefiddle.c
View file

@ -152,7 +152,7 @@ case_character_impl (struct casing_str_buf *buf,
prop = CHAR_TABLE_REF (ctx->titlecase_char_table, ch);
if (CHARACTERP (prop))
{
cased = XFASTINT (prop);
cased = XFIXNAT (prop);
cased_is_set = true;
}
}
@ -225,7 +225,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int ch = XFASTINT (obj);
int ch = XFIXNAT (obj);
/* If the character has higher bits set above the flags, return it unchanged.
It is not a real character. */
@ -250,7 +250,7 @@ do_casify_natnum (struct casing_context *ctx, Lisp_Object obj)
if (! multibyte)
MAKE_CHAR_UNIBYTE (cased);
return make_natnum (cased | flags);
return make_fixed_natnum (cased | flags);
}
static Lisp_Object
@ -319,7 +319,7 @@ casify_object (enum case_action flag, Lisp_Object obj)
struct casing_context ctx;
prepare_casing_context (&ctx, flag, false);
if (NATNUMP (obj))
if (FIXNATP (obj))
return do_casify_natnum (&ctx, obj);
else if (!STRINGP (obj))
wrong_type_argument (Qchar_or_string_p, obj);
@ -485,8 +485,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e)
struct casing_context ctx;
validate_region (&b, &e);
ptrdiff_t start = XFASTINT (b);
ptrdiff_t end = XFASTINT (e);
ptrdiff_t start = XFIXNAT (b);
ptrdiff_t end = XFIXNAT (e);
if (start == end)
/* Not modifying because nothing marked. */
return end;
@ -601,11 +601,11 @@ character positions to operate on. */)
static Lisp_Object
casify_word (enum case_action flag, Lisp_Object arg)
{
CHECK_NUMBER (arg);
ptrdiff_t farend = scan_words (PT, XINT (arg));
CHECK_FIXNUM (arg);
ptrdiff_t farend = scan_words (PT, XFIXNUM (arg));
if (!farend)
farend = XINT (arg) <= 0 ? BEGV : ZV;
SET_PT (casify_region (flag, make_number (PT), make_number (farend)));
farend = XFIXNUM (arg) <= 0 ? BEGV : ZV;
SET_PT (casify_region (flag, make_fixnum (PT), make_fixnum (farend)));
return Qnil;
}

32
src/casetab.c
View file

@ -179,7 +179,7 @@ set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt)
Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
if (NATNUMP (elt))
if (FIXNATP (elt))
Fset_char_table_range (canon, range, Faref (case_table, Faref (up, elt)));
}
@ -191,21 +191,21 @@ set_canon (Lisp_Object case_table, Lisp_Object range, Lisp_Object elt)
static void
set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
{
if (NATNUMP (elt))
if (FIXNATP (elt))
{
int from, to;
if (CONSP (c))
{
from = XINT (XCAR (c));
to = XINT (XCDR (c));
from = XFIXNUM (XCAR (c));
to = XFIXNUM (XCDR (c));
}
else
from = to = XINT (c);
from = to = XFIXNUM (c);
to++;
for (; from < to; from++)
CHAR_TABLE_SET (table, from, make_number (from));
CHAR_TABLE_SET (table, from, make_fixnum (from));
}
}
@ -217,24 +217,24 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
static void
shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
{
if (NATNUMP (elt))
if (FIXNATP (elt))
{
int from, to;
if (CONSP (c))
{
from = XINT (XCAR (c));
to = XINT (XCDR (c));
from = XFIXNUM (XCAR (c));
to = XFIXNUM (XCDR (c));
}
else
from = to = XINT (c);
from = to = XFIXNUM (c);
to++;
for (; from < to; from++)
{
Lisp_Object tem = Faref (table, elt);
Faset (table, elt, make_number (from));
Faset (table, make_number (from), tem);
Faset (table, elt, make_fixnum (from));
Faset (table, make_fixnum (from), tem);
}
}
}
@ -246,7 +246,7 @@ init_casetab_once (void)
Lisp_Object down, up, eqv;
DEFSYM (Qcase_table, "case-table");
Fput (Qcase_table, Qchar_table_extra_slots, make_number (3));
Fput (Qcase_table, Qchar_table_extra_slots, make_fixnum (3));
down = Fmake_char_table (Qcase_table, Qnil);
Vascii_downcase_table = down;
@ -255,7 +255,7 @@ init_casetab_once (void)
for (i = 0; i < 128; i++)
{
int c = (i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i;
CHAR_TABLE_SET (down, i, make_number (c));
CHAR_TABLE_SET (down, i, make_fixnum (c));
}
set_char_table_extras (down, 1, Fcopy_sequence (down));
@ -266,7 +266,7 @@ init_casetab_once (void)
for (i = 0; i < 128; i++)
{
int c = (i >= 'a' && i <= 'z') ? i + ('A' - 'a') : i;
CHAR_TABLE_SET (up, i, make_number (c));
CHAR_TABLE_SET (up, i, make_fixnum (c));
}
eqv = Fmake_char_table (Qcase_table, Qnil);
@ -276,7 +276,7 @@ init_casetab_once (void)
int c = ((i >= 'A' && i <= 'Z') ? i + ('a' - 'A')
: ((i >= 'a' && i <= 'z') ? i + ('A' - 'a')
: i));
CHAR_TABLE_SET (eqv, i, make_number (c));
CHAR_TABLE_SET (eqv, i, make_fixnum (c));
}
set_char_table_extras (down, 2, eqv);

52
src/category.c
View file

@ -103,7 +103,7 @@ those categories. */)
while (--len >= 0)
{
unsigned char cat = SREF (categories, len);
Lisp_Object category = make_number (cat);
Lisp_Object category = make_fixnum (cat);
CHECK_CATEGORY (category);
set_category_set (val, cat, 1);
@ -130,11 +130,11 @@ the current buffer's category table. */)
CHECK_STRING (docstring);
table = check_category_table (table);
if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Category `%c' is already defined", (int) XFASTINT (category));
if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category))))
error ("Category `%c' is already defined", (int) XFIXNAT (category));
if (!NILP (Vpurify_flag))
docstring = Fpurecopy (docstring);
SET_CATEGORY_DOCSTRING (table, XFASTINT (category), docstring);
SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring);
return Qnil;
}
@ -148,7 +148,7 @@ category table. */)
CHECK_CATEGORY (category);
table = check_category_table (table);
return CATEGORY_DOCSTRING (table, XFASTINT (category));
return CATEGORY_DOCSTRING (table, XFIXNAT (category));
}
DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
@ -165,7 +165,7 @@ it defaults to the current buffer's category table. */)
for (i = ' '; i <= '~'; i++)
if (NILP (CATEGORY_DOCSTRING (table, i)))
return make_number (i);
return make_fixnum (i);
return Qnil;
}
@ -220,9 +220,9 @@ copy_category_entry (Lisp_Object table, Lisp_Object c, Lisp_Object val)
{
val = Fcopy_sequence (val);
if (CONSP (c))
char_table_set_range (table, XINT (XCAR (c)), XINT (XCDR (c)), val);
char_table_set_range (table, XFIXNUM (XCAR (c)), XFIXNUM (XCDR (c)), val);
else
char_table_set (table, XINT (c), val);
char_table_set (table, XFIXNUM (c), val);
}
/* Return a copy of category table TABLE. We can't simply use the
@ -271,8 +271,8 @@ DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
set_char_table_defalt (val, MAKE_CATEGORY_SET);
for (i = 0; i < (1 << CHARTAB_SIZE_BITS_0); i++)
set_char_table_contents (val, i, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
Fset_char_table_extra_slot (val, make_fixnum (0),
Fmake_vector (make_fixnum (95), Qnil));
return val;
}
@ -303,7 +303,7 @@ usage: (char-category-set CHAR) */)
(Lisp_Object ch)
{
CHECK_CHARACTER (ch);
return CATEGORY_SET (XFASTINT (ch));
return CATEGORY_SET (XFIXNAT (ch));
}
DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
@ -346,25 +346,25 @@ then delete CATEGORY from the category set instead of adding it. */)
int start, end;
int from, to;
if (INTEGERP (character))
if (FIXNUMP (character))
{
CHECK_CHARACTER (character);
start = end = XFASTINT (character);
start = end = XFIXNAT (character);
}
else
{
CHECK_CONS (character);
CHECK_CHARACTER_CAR (character);
CHECK_CHARACTER_CDR (character);
start = XFASTINT (XCAR (character));
end = XFASTINT (XCDR (character));
start = XFIXNAT (XCAR (character));
end = XFIXNAT (XCDR (character));
}
CHECK_CATEGORY (category);
table = check_category_table (table);
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Undefined category: %c", (int) XFASTINT (category));
if (NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category))))
error ("Undefined category: %c", (int) XFIXNAT (category));
set_value = NILP (reset);
@ -372,10 +372,10 @@ then delete CATEGORY from the category set instead of adding it. */)
{
from = start, to = end;
category_set = char_table_ref_and_range (table, start, &from, &to);
if (CATEGORY_MEMBER (XFASTINT (category), category_set) != NILP (reset))
if (CATEGORY_MEMBER (XFIXNAT (category), category_set) != NILP (reset))
{
category_set = Fcopy_sequence (category_set);
set_category_set (category_set, XFASTINT (category), set_value);
set_category_set (category_set, XFIXNAT (category), set_value);
category_set = hash_get_category_set (table, category_set);
char_table_set_range (table, start, to, category_set);
}
@ -423,12 +423,12 @@ word_boundary_p (int c1, int c2)
if (CONSP (elt)
&& (NILP (XCAR (elt))
|| (CATEGORYP (XCAR (elt))
&& CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)
&& ! CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set2)))
&& CATEGORY_MEMBER (XFIXNAT (XCAR (elt)), category_set1)
&& ! CATEGORY_MEMBER (XFIXNAT (XCAR (elt)), category_set2)))
&& (NILP (XCDR (elt))
|| (CATEGORYP (XCDR (elt))
&& ! CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set1)
&& CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2))))
&& ! CATEGORY_MEMBER (XFIXNAT (XCDR (elt)), category_set1)
&& CATEGORY_MEMBER (XFIXNAT (XCDR (elt)), category_set2))))
return !default_result;
}
return default_result;
@ -440,13 +440,13 @@ init_category_once (void)
{
/* This has to be done here, before we call Fmake_char_table. */
DEFSYM (Qcategory_table, "category-table");
Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
Fput (Qcategory_table, Qchar_table_extra_slots, make_fixnum (2));
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
/* Set a category set which contains nothing to the default. */
set_char_table_defalt (Vstandard_category_table, MAKE_CATEGORY_SET);
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
Fset_char_table_extra_slot (Vstandard_category_table, make_fixnum (0),
Fmake_vector (make_fixnum (95), Qnil));
}
void

12
src/category.h
View file

@ -59,7 +59,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
INLINE_HEADER_BEGIN
#define CATEGORYP(x) RANGED_INTEGERP (0x20, x, 0x7E)
#define CATEGORYP(x) RANGED_FIXNUMP (0x20, x, 0x7E)
#define CHECK_CATEGORY(x) \
CHECK_TYPE (CATEGORYP (x), Qcategoryp, x)
@ -68,7 +68,7 @@ INLINE_HEADER_BEGIN
(BOOL_VECTOR_P (x) && bool_vector_size (x) == 128)
/* Return a new empty category set. */
#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_number (128), Qnil))
#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_fixnum (128), Qnil))
#define CHECK_CATEGORY_SET(x) \
CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x)
@ -77,7 +77,7 @@ INLINE_HEADER_BEGIN
#define CATEGORY_SET(c) char_category_set (c)
/* Return true if CATEGORY_SET contains CATEGORY.
Faster than '!NILP (Faref (category_set, make_number (category)))'. */
Faster than '!NILP (Faref (category_set, make_fixnum (category)))'. */
INLINE bool
CATEGORY_MEMBER (EMACS_INT category, Lisp_Object category_set)
{
@ -98,16 +98,16 @@ CHAR_HAS_CATEGORY (int ch, int category)
/* Return the doc string of CATEGORY in category table TABLE. */
#define CATEGORY_DOCSTRING(table, category) \
AREF (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '))
AREF (Fchar_table_extra_slot (table, make_fixnum (0)), ((category) - ' '))
/* Set the doc string of CATEGORY to VALUE in category table TABLE. */
#define SET_CATEGORY_DOCSTRING(table, category, value) \
ASET (Fchar_table_extra_slot (table, make_number (0)), ((category) - ' '), value)
ASET (Fchar_table_extra_slot (table, make_fixnum (0)), ((category) - ' '), value)
/* Return the version number of category table TABLE. Not used for
the moment. */
#define CATEGORY_TABLE_VERSION (table) \
Fchar_table_extra_slot (table, make_number (1))
Fchar_table_extra_slot (table, make_fixnum (1))
/* Return true if there is a word boundary between two
word-constituent characters C1 and C2 if they appear in this order.

188
src/ccl.c
View file

@ -629,7 +629,7 @@ do \
stack_idx++; \
ccl_prog = called_ccl.prog; \
ic = CCL_HEADER_MAIN; \
eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]); \
eof_ic = XFIXNAT (ccl_prog[CCL_HEADER_EOF]); \
goto ccl_repeat; \
} \
while (0)
@ -736,7 +736,7 @@ while (0)
#define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \
do \
{ \
EMACS_INT prog_word = XINT ((ccl_prog)[ic]); \
EMACS_INT prog_word = XFIXNUM ((ccl_prog)[ic]); \
if (! ASCENDING_ORDER (lo, prog_word, hi)) \
CCL_INVALID_CMD; \
(var) = prog_word; \
@ -769,12 +769,12 @@ while (0)
CCL_INVALID_CMD; \
else if (dst + len <= dst_end) \
{ \
if (XFASTINT (ccl_prog[ic]) & 0x1000000) \
if (XFIXNAT (ccl_prog[ic]) & 0x1000000) \
for (ccli = 0; ccli < len; ccli++) \
*dst++ = XFASTINT (ccl_prog[ic + ccli]) & 0xFFFFFF; \
*dst++ = XFIXNAT (ccl_prog[ic + ccli]) & 0xFFFFFF; \
else \
for (ccli = 0; ccli < len; ccli++) \
*dst++ = ((XFASTINT (ccl_prog[ic + (ccli / 3)])) \
*dst++ = ((XFIXNAT (ccl_prog[ic + (ccli / 3)])) \
>> ((2 - (ccli % 3)) * 8)) & 0xFF; \
} \
else \
@ -926,14 +926,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
reg[rrr] = XINT (ccl_prog[ic++]);
reg[rrr] = XFIXNUM (ccl_prog[ic++]);
break;
case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
i = reg[RRR];
j = field1 >> 3;
if (0 <= i && i < j)
reg[rrr] = XINT (ccl_prog[ic + i]);
reg[rrr] = XFIXNUM (ccl_prog[ic + i]);
ic += j;
break;
@ -961,13 +961,13 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
i = XINT (ccl_prog[ic]);
i = XFIXNUM (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic += ADDR;
break;
case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
i = XINT (ccl_prog[ic]);
i = XFIXNUM (ccl_prog[ic]);
CCL_WRITE_CHAR (i);
ic++;
CCL_READ_CHAR (reg[rrr]);
@ -975,17 +975,17 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
break;
case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
j = XINT (ccl_prog[ic++]);
j = XFIXNUM (ccl_prog[ic++]);
CCL_WRITE_STRING (j);
ic += ADDR - 1;
break;
case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
j = XINT (ccl_prog[ic]);
j = XFIXNUM (ccl_prog[ic]);
if (0 <= i && i < j)
{
i = XINT (ccl_prog[ic + 1 + i]);
i = XFIXNUM (ccl_prog[ic + 1 + i]);
CCL_WRITE_CHAR (i);
}
ic += j + 2;
@ -1004,7 +1004,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
{
int ioff = 0 <= reg[rrr] && reg[rrr] < field1 ? reg[rrr] : field1;
int incr = XINT (ccl_prog[ic + ioff]);
int incr = XFIXNUM (ccl_prog[ic + ioff]);
ic += incr;
}
break;
@ -1023,7 +1023,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
rrr = 7;
i = reg[RRR];
j = XINT (ccl_prog[ic]);
j = XFIXNUM (ccl_prog[ic]);
op = field1 >> 6;
jump_address = ic + 1;
goto ccl_set_expr;
@ -1056,7 +1056,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* If FFF is nonzero, the CCL program ID is in the
following code. */
if (rrr)
prog_id = XINT (ccl_prog[ic++]);
prog_id = XFIXNUM (ccl_prog[ic++]);
else
prog_id = field1;
@ -1081,7 +1081,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
stack_idx++;
ccl_prog = XVECTOR (AREF (slot, 1))->contents;
ic = CCL_HEADER_MAIN;
eof_ic = XFASTINT (ccl_prog[CCL_HEADER_EOF]);
eof_ic = XFIXNAT (ccl_prog[CCL_HEADER_EOF]);
}
break;
@ -1099,7 +1099,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
i = reg[rrr];
if (0 <= i && i < field1)
{
j = XINT (ccl_prog[ic + i]);
j = XFIXNUM (ccl_prog[ic + i]);
CCL_WRITE_CHAR (j);
}
ic += field1;
@ -1124,7 +1124,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
CCL_SUCCESS;
case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
i = XINT (ccl_prog[ic++]);
i = XFIXNUM (ccl_prog[ic++]);
op = field1 >> 6;
goto ccl_expr_self;
@ -1160,7 +1160,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
i = reg[RRR];
j = XINT (ccl_prog[ic++]);
j = XFIXNUM (ccl_prog[ic++]);
op = field1 >> 6;
jump_address = ic;
goto ccl_set_expr;
@ -1178,8 +1178,8 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
i = reg[rrr];
jump_address = ic + ADDR;
op = XINT (ccl_prog[ic++]);
j = XINT (ccl_prog[ic++]);
op = XFIXNUM (ccl_prog[ic++]);
j = XFIXNUM (ccl_prog[ic++]);
rrr = 7;
goto ccl_set_expr;
@ -1189,7 +1189,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
case CCL_JumpCondExprReg:
i = reg[rrr];
jump_address = ic + ADDR;
op = XINT (ccl_prog[ic++]);
op = XFIXNUM (ccl_prog[ic++]);
GET_CCL_RANGE (j, ccl_prog, ic++, 0, 7);
j = reg[j];
rrr = 7;
@ -1291,7 +1291,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
: -1));
h = GET_HASH_TABLE (eop);
eop = hash_lookup (h, make_number (reg[RRR]), NULL);
eop = hash_lookup (h, make_fixnum (reg[RRR]), NULL);
if (eop >= 0)
{
Lisp_Object opl;
@ -1318,14 +1318,14 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
i = CCL_DECODE_CHAR (reg[RRR], reg[rrr]);
h = GET_HASH_TABLE (eop);
eop = hash_lookup (h, make_number (i), NULL);
eop = hash_lookup (h, make_fixnum (i), NULL);
if (eop >= 0)
{
Lisp_Object opl;
opl = HASH_VALUE (h, eop);
if (! (INTEGERP (opl) && IN_INT_RANGE (XINT (opl))))
if (! (FIXNUMP (opl) && IN_INT_RANGE (XFIXNUM (opl))))
CCL_INVALID_CMD;
reg[RRR] = XINT (opl);
reg[RRR] = XFIXNUM (opl);
reg[7] = 1; /* r7 true for success */
}
else
@ -1340,7 +1340,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
ptrdiff_t size;
int fin_ic;
j = XINT (ccl_prog[ic++]); /* number of maps. */
j = XFIXNUM (ccl_prog[ic++]); /* number of maps. */
fin_ic = ic + j;
op = reg[rrr];
if ((j > reg[RRR]) && (j >= 0))
@ -1359,7 +1359,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
if (!VECTORP (Vcode_conversion_map_vector)) continue;
size = ASIZE (Vcode_conversion_map_vector);
point = XINT (ccl_prog[ic++]);
point = XFIXNUM (ccl_prog[ic++]);
if (! (0 <= point && point < size)) continue;
map = AREF (Vcode_conversion_map_vector, point);
@ -1375,19 +1375,19 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
if (INTEGERP (content))
if (FIXNUMP (content))
{
point = XINT (content);
point = XFIXNUM (content);
if (!(point <= op && op - point + 1 < size)) continue;
content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
if (INTEGERP (AREF (map, 2))
&& XINT (AREF (map, 2)) <= op
&& INTEGERP (AREF (map, 3))
&& op < XINT (AREF (map, 3)))
if (FIXNUMP (AREF (map, 2))
&& XFIXNUM (AREF (map, 2)) <= op
&& FIXNUMP (AREF (map, 3))
&& op < XFIXNUM (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
@ -1397,10 +1397,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
if (NILP (content))
continue;
else if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
else if (FIXNUMP (content) && IN_INT_RANGE (XFIXNUM (content)))
{
reg[RRR] = i;
reg[rrr] = XINT (content);
reg[rrr] = XFIXNUM (content);
break;
}
else if (EQ (content, Qt) || EQ (content, Qlambda))
@ -1412,11 +1412,11 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
attrib = XCAR (content);
value = XCDR (content);
if (! (INTEGERP (attrib) && INTEGERP (value)
&& IN_INT_RANGE (XINT (value))))
if (! (FIXNUMP (attrib) && FIXNUMP (value)
&& IN_INT_RANGE (XFIXNUM (value))))
continue;
reg[RRR] = i;
reg[rrr] = XINT (value);
reg[rrr] = XFIXNUM (value);
break;
}
else if (SYMBOLP (content))
@ -1453,7 +1453,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
stack_idx_of_map_multiple = 0;
/* Get number of maps and separators. */
map_set_rest_length = XINT (ccl_prog[ic++]);
map_set_rest_length = XFIXNUM (ccl_prog[ic++]);
fin_ic = ic + map_set_rest_length;
op = reg[rrr];
@ -1524,7 +1524,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
do {
for (;map_set_rest_length > 0;i++, ic++, map_set_rest_length--)
{
point = XINT (ccl_prog[ic]);
point = XFIXNUM (ccl_prog[ic]);
if (point < 0)
{
/* +1 is for including separator. */
@ -1554,19 +1554,19 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
/* check map type,
[STARTPOINT VAL1 VAL2 ...] or
[t ELEMENT STARTPOINT ENDPOINT] */
if (INTEGERP (content))
if (FIXNUMP (content))
{
point = XINT (content);
point = XFIXNUM (content);
if (!(point <= op && op - point + 1 < size)) continue;
content = AREF (map, op - point + 1);
}
else if (EQ (content, Qt))
{
if (size != 4) continue;
if (INTEGERP (AREF (map, 2))
&& XINT (AREF (map, 2)) <= op
&& INTEGERP (AREF (map, 3))
&& op < XINT (AREF (map, 3)))
if (FIXNUMP (AREF (map, 2))
&& XFIXNUM (AREF (map, 2)) <= op
&& FIXNUMP (AREF (map, 3))
&& op < XFIXNUM (AREF (map, 3)))
content = AREF (map, 1);
else
continue;
@ -1578,9 +1578,9 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
continue;
reg[RRR] = i;
if (INTEGERP (content) && IN_INT_RANGE (XINT (content)))
if (FIXNUMP (content) && IN_INT_RANGE (XFIXNUM (content)))
{
op = XINT (content);
op = XFIXNUM (content);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
@ -1590,10 +1590,10 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
attrib = XCAR (content);
value = XCDR (content);
if (! (INTEGERP (attrib) && INTEGERP (value)
&& IN_INT_RANGE (XINT (value))))
if (! (FIXNUMP (attrib) && FIXNUMP (value)
&& IN_INT_RANGE (XFIXNUM (value))))
continue;
op = XINT (value);
op = XFIXNUM (value);
i += map_set_rest_length - 1;
ic += map_set_rest_length - 1;
POP_MAPPING_STACK (map_set_rest_length, reg[rrr]);
@ -1639,7 +1639,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
{
Lisp_Object map, attrib, value, content;
int point;
j = XINT (ccl_prog[ic++]); /* map_id */
j = XFIXNUM (ccl_prog[ic++]); /* map_id */
op = reg[rrr];
if (! (VECTORP (Vcode_conversion_map_vector)
&& j < ASIZE (Vcode_conversion_map_vector)))
@ -1656,29 +1656,29 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
map = XCDR (map);
if (! (VECTORP (map)
&& 0 < ASIZE (map)
&& INTEGERP (AREF (map, 0))
&& XINT (AREF (map, 0)) <= op
&& op - XINT (AREF (map, 0)) + 1 < ASIZE (map)))
&& FIXNUMP (AREF (map, 0))
&& XFIXNUM (AREF (map, 0)) <= op
&& op - XFIXNUM (AREF (map, 0)) + 1 < ASIZE (map)))
{
reg[RRR] = -1;
break;
}
point = op - XINT (AREF (map, 0)) + 1;
point = op - XFIXNUM (AREF (map, 0)) + 1;
reg[RRR] = 0;
content = AREF (map, point);
if (NILP (content))
reg[RRR] = -1;
else if (TYPE_RANGED_INTEGERP (int, content))
reg[rrr] = XINT (content);
else if (TYPE_RANGED_FIXNUMP (int, content))
reg[rrr] = XFIXNUM (content);
else if (EQ (content, Qt));
else if (CONSP (content))
{
attrib = XCAR (content);
value = XCDR (content);
if (!INTEGERP (attrib)
|| !TYPE_RANGED_INTEGERP (int, value))
if (!FIXNUMP (attrib)
|| !TYPE_RANGED_FIXNUMP (int, value))
continue;
reg[rrr] = XINT (value);
reg[rrr] = XFIXNUM (value);
break;
}
else if (SYMBOLP (content))
@ -1809,7 +1809,7 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
for (i = 0; i < veclen; i++)
{
contents = AREF (result, i);
if (TYPE_RANGED_INTEGERP (int, contents))
if (TYPE_RANGED_FIXNUMP (int, contents))
continue;
else if (CONSP (contents)
&& SYMBOLP (XCAR (contents))
@ -1819,7 +1819,7 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
(SYMBOL . PROPERTY). (get SYMBOL PROPERTY) should give
an index number. */
val = Fget (XCAR (contents), XCDR (contents));
if (RANGED_INTEGERP (0, val, INT_MAX))
if (RANGED_FIXNUMP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
@ -1831,17 +1831,17 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
may lead to a bug if, for instance, a translation table
and a code conversion map have the same name. */
val = Fget (contents, Qtranslation_table_id);
if (RANGED_INTEGERP (0, val, INT_MAX))
if (RANGED_FIXNUMP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qcode_conversion_map_id);
if (RANGED_INTEGERP (0, val, INT_MAX))
if (RANGED_FIXNUMP (0, val, INT_MAX))
ASET (result, i, val);
else
{
val = Fget (contents, Qccl_program_idx);
if (RANGED_INTEGERP (0, val, INT_MAX))
if (RANGED_FIXNUMP (0, val, INT_MAX))
ASET (result, i, val);
else
unresolved = 1;
@ -1852,8 +1852,8 @@ resolve_symbol_ccl_program (Lisp_Object ccl)
return Qnil;
}
if (! (0 <= XINT (AREF (result, CCL_HEADER_BUF_MAG))
&& ASCENDING_ORDER (0, XINT (AREF (result, CCL_HEADER_EOF)),
if (! (0 <= XFIXNUM (AREF (result, CCL_HEADER_BUF_MAG))
&& ASCENDING_ORDER (0, XFIXNUM (AREF (result, CCL_HEADER_EOF)),
ASIZE (ccl))))
return Qnil;
@ -1881,15 +1881,15 @@ ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t *idx)
return Qnil;
val = Fget (ccl_prog, Qccl_program_idx);
if (! NATNUMP (val)
|| XINT (val) >= ASIZE (Vccl_program_table))
if (! FIXNATP (val)
|| XFIXNUM (val) >= ASIZE (Vccl_program_table))
return Qnil;
slot = AREF (Vccl_program_table, XINT (val));
slot = AREF (Vccl_program_table, XFIXNUM (val));
if (! VECTORP (slot)
|| ASIZE (slot) != 4
|| ! VECTORP (AREF (slot, 1)))
return Qnil;
*idx = XINT (val);
*idx = XFIXNUM (val);
if (NILP (AREF (slot, 2)))
{
val = resolve_symbol_ccl_program (AREF (slot, 1));
@ -1920,8 +1920,8 @@ setup_ccl_program (struct ccl_program *ccl, Lisp_Object ccl_prog)
vp = XVECTOR (ccl_prog);
ccl->size = vp->header.size;
ccl->prog = vp->contents;
ccl->eof_ic = XINT (vp->contents[CCL_HEADER_EOF]);
ccl->buf_magnification = XINT (vp->contents[CCL_HEADER_BUF_MAG]);
ccl->eof_ic = XFIXNUM (vp->contents[CCL_HEADER_EOF]);
ccl->buf_magnification = XFIXNUM (vp->contents[CCL_HEADER_BUF_MAG]);
if (ccl->idx >= 0)
{
Lisp_Object slot;
@ -1956,8 +1956,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program. */
return Qnil;
val = Fget (object, Qccl_program_idx);
return ((! NATNUMP (val)
|| XINT (val) >= ASIZE (Vccl_program_table))
return ((! FIXNATP (val)
|| XFIXNUM (val) >= ASIZE (Vccl_program_table))
? Qnil : Qt);
}
@ -1990,8 +1990,8 @@ programs. */)
error ("Length of vector REGISTERS is not 8");
for (i = 0; i < 8; i++)
ccl.reg[i] = (TYPE_RANGED_INTEGERP (int, AREF (reg, i))
? XINT (AREF (reg, i))
ccl.reg[i] = (TYPE_RANGED_FIXNUMP (int, AREF (reg, i))
? XFIXNUM (AREF (reg, i))
: 0);
ccl_driver (&ccl, NULL, NULL, 0, 0, Qnil);
@ -2000,7 +2000,7 @@ programs. */)
error ("Error in CCL program at %dth code", ccl.ic);
for (i = 0; i < 8; i++)
ASET (reg, i, make_number (ccl.reg[i]));
ASET (reg, i, make_fixnum (ccl.reg[i]));
return Qnil;
}
@ -2058,13 +2058,13 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
for (i = 0; i < 8; i++)
{
if (NILP (AREF (status, i)))
ASET (status, i, make_number (0));
if (TYPE_RANGED_INTEGERP (int, AREF (status, i)))
ccl.reg[i] = XINT (AREF (status, i));
ASET (status, i, make_fixnum (0));
if (TYPE_RANGED_FIXNUMP (int, AREF (status, i)))
ccl.reg[i] = XFIXNUM (AREF (status, i));
}
if (INTEGERP (AREF (status, i)))
if (FIXNUMP (AREF (status, i)))
{
i = XFASTINT (AREF (status, 8));
i = XFIXNAT (AREF (status, 8));
if (ccl.ic < i && i < ccl.size)
ccl.ic = i;
}
@ -2139,8 +2139,8 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
error ("CCL program interrupted at %dth code", ccl.ic);
for (i = 0; i < 8; i++)
ASET (status, i, make_number (ccl.reg[i]));
ASET (status, 8, make_number (ccl.ic));
ASET (status, i, make_fixnum (ccl.reg[i]));
ASET (status, 8, make_fixnum (ccl.ic));
val = make_specified_string ((const char *) outbuf, produced_chars,
outp - outbuf, NILP (unibyte_p));
@ -2193,7 +2193,7 @@ Return index number of the registered CCL program. */)
ASET (slot, 1, ccl_prog);
ASET (slot, 2, resolved);
ASET (slot, 3, Qt);
return make_number (idx);
return make_fixnum (idx);
}
}
@ -2211,8 +2211,8 @@ Return index number of the registered CCL program. */)
ASET (Vccl_program_table, idx, elt);
}
Fput (name, Qccl_program_idx, make_number (idx));
return make_number (idx);
Fput (name, Qccl_program_idx, make_fixnum (idx));
return make_fixnum (idx);
}
/* Register code conversion map.
@ -2251,7 +2251,7 @@ Return index number of the registered map. */)
if (EQ (symbol, XCAR (slot)))
{
idx = make_number (i);
idx = make_fixnum (i);
XSETCDR (slot, map);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_id, idx);
@ -2263,7 +2263,7 @@ Return index number of the registered map. */)
Vcode_conversion_map_vector = larger_vector (Vcode_conversion_map_vector,
1, -1);
idx = make_number (i);
idx = make_fixnum (i);
Fput (symbol, Qcode_conversion_map, map);
Fput (symbol, Qcode_conversion_map_id, idx);
ASET (Vcode_conversion_map_vector, i, Fcons (symbol, map));
@ -2275,7 +2275,7 @@ void
syms_of_ccl (void)
{
staticpro (&Vccl_program_table);
Vccl_program_table = Fmake_vector (make_number (32), Qnil);
Vccl_program_table = Fmake_vector (make_fixnum (32), Qnil);
DEFSYM (Qccl, "ccl");
DEFSYM (Qcclp, "cclp");
@ -2291,7 +2291,7 @@ syms_of_ccl (void)
DEFVAR_LISP ("code-conversion-map-vector", Vcode_conversion_map_vector,
doc: /* Vector of code conversion maps. */);
Vcode_conversion_map_vector = Fmake_vector (make_number (16), Qnil);
Vcode_conversion_map_vector = Fmake_vector (make_fixnum (16), Qnil);
DEFVAR_LISP ("font-ccl-encoder-alist", Vfont_ccl_encoder_alist,
doc: /* Alist of fontname patterns vs corresponding CCL program.

84
src/character.c
View file

@ -207,7 +207,7 @@ translate_char (Lisp_Object table, int c)
ch = CHAR_TABLE_REF (table, c);
if (CHARACTERP (ch))
c = XINT (ch);
c = XFIXNUM (ch);
}
else
{
@ -234,7 +234,7 @@ DEFUN ("max-char", Fmax_char, Smax_char, 0, 0, 0,
attributes: const)
(void)
{
return make_number (MAX_CHAR);
return make_fixnum (MAX_CHAR);
}
DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
@ -245,11 +245,11 @@ DEFUN ("unibyte-char-to-multibyte", Funibyte_char_to_multibyte,
int c;
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
c = XFIXNAT (ch);
if (c >= 0x100)
error ("Not a unibyte character: %d", c);
MAKE_CHAR_MULTIBYTE (c);
return make_number (c);
return make_fixnum (c);
}
DEFUN ("multibyte-char-to-unibyte", Fmultibyte_char_to_unibyte,
@ -261,7 +261,7 @@ If the multibyte character does not represent a byte, return -1. */)
int cm;
CHECK_CHARACTER (ch);
cm = XFASTINT (ch);
cm = XFIXNAT (ch);
if (cm < 256)
/* Can't distinguish a byte read from a unibyte buffer from
a latin1 char, so let's let it slide. */
@ -269,7 +269,7 @@ If the multibyte character does not represent a byte, return -1. */)
else
{
int cu = CHAR_TO_BYTE_SAFE (cm);
return make_number (cu);
return make_fixnum (cu);
}
}
@ -294,7 +294,7 @@ char_width (int c, struct Lisp_Char_Table *dp)
if (GLYPH_CODE_P (ch))
c = GLYPH_CODE_CHAR (ch);
else if (CHARACTERP (ch))
c = XFASTINT (ch);
c = XFIXNUM (ch);
if (c >= 0)
{
int w = CHARACTER_WIDTH (c);
@ -318,9 +318,9 @@ usage: (char-width CHAR) */)
ptrdiff_t width;
CHECK_CHARACTER (ch);
c = XINT (ch);
c = XFIXNUM (ch);
width = char_width (c, buffer_display_table ());
return make_number (width);
return make_fixnum (width);
}
/* Return width of string STR of length LEN when displayed in the
@ -861,7 +861,7 @@ usage: (string &rest CHARACTERS) */)
for (i = 0; i < n; i++)
{
CHECK_CHARACTER (args[i]);
c = XINT (args[i]);
c = XFIXNUM (args[i]);
p += CHAR_STRING (c, p);
}
@ -884,7 +884,7 @@ usage: (unibyte-string &rest BYTES) */)
for (i = 0; i < n; i++)
{
CHECK_RANGED_INTEGER (args[i], 0, 255);
*p++ = XINT (args[i]);
*p++ = XFIXNUM (args[i]);
}
str = make_string_from_bytes ((char *) buf, n, p - buf);
@ -902,9 +902,9 @@ usage: (char-resolve-modifiers CHAR) */)
{
EMACS_INT c;
CHECK_NUMBER (character);
c = XINT (character);
return make_number (char_resolve_modifier_mask (c));
CHECK_FIXNUM (character);
c = XFIXNUM (character);
return make_fixnum (char_resolve_modifier_mask (c));
}
DEFUN ("get-byte", Fget_byte, Sget_byte, 0, 2, 0,
@ -931,14 +931,14 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
}
else
{
CHECK_NUMBER_COERCE_MARKER (position);
if (XINT (position) < BEGV || XINT (position) >= ZV)
args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
pos = XFASTINT (position);
CHECK_FIXNUM_COERCE_MARKER (position);
if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV)
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
pos = XFIXNAT (position);
p = CHAR_POS_ADDR (pos);
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return make_number (*p);
return make_fixnum (*p);
}
else
{
@ -949,21 +949,21 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
}
else
{
CHECK_NATNUM (position);
if (XINT (position) >= SCHARS (string))
CHECK_FIXNAT (position);
if (XFIXNUM (position) >= SCHARS (string))
args_out_of_range (string, position);
pos = XFASTINT (position);
pos = XFIXNAT (position);
p = SDATA (string) + string_char_to_byte (string, pos);
}
if (! STRING_MULTIBYTE (string))
return make_number (*p);
return make_fixnum (*p);
}
c = STRING_CHAR (p);
if (CHAR_BYTE8_P (c))
c = CHAR_TO_BYTE8 (c);
else if (! ASCII_CHAR_P (c))
error ("Not an ASCII nor an 8-bit character: %d", c);
return make_number (c);
return make_fixnum (c);
}
/* Return true if C is an alphabetic character. */
@ -971,9 +971,9 @@ bool
alphabeticp (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
if (! FIXNUMP (category))
return false;
EMACS_INT gen_cat = XINT (category);
EMACS_INT gen_cat = XFIXNUM (category);
/* See UTS #18. There are additional characters that should be
here, those designated as Other_uppercase, Other_lowercase,
@ -994,9 +994,9 @@ bool
alphanumericp (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
if (! FIXNUMP (category))
return false;
EMACS_INT gen_cat = XINT (category);
EMACS_INT gen_cat = XFIXNUM (category);
/* See UTS #18. Same comment as for alphabeticp applies. FIXME. */
return (gen_cat == UNICODE_CATEGORY_Lu
@ -1016,9 +1016,9 @@ bool
graphicp (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
if (! FIXNUMP (category))
return false;
EMACS_INT gen_cat = XINT (category);
EMACS_INT gen_cat = XFIXNUM (category);
/* See UTS #18. */
return (!(gen_cat == UNICODE_CATEGORY_Zs /* space separator */
@ -1034,9 +1034,9 @@ bool
printablep (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
if (! FIXNUMP (category))
return false;
EMACS_INT gen_cat = XINT (category);
EMACS_INT gen_cat = XFIXNUM (category);
/* See UTS #18. */
return (!(gen_cat == UNICODE_CATEGORY_Cc /* control */
@ -1050,10 +1050,10 @@ bool
blankp (int c)
{
Lisp_Object category = CHAR_TABLE_REF (Vunicode_category_table, c);
if (! INTEGERP (category))
if (! FIXNUMP (category))
return false;
return XINT (category) == UNICODE_CATEGORY_Zs; /* separator, space */
return XFIXNUM (category) == UNICODE_CATEGORY_Zs; /* separator, space */
}
@ -1124,7 +1124,7 @@ syms_of_character (void)
Vector recording all translation tables ever defined.
Each element is a pair (SYMBOL . TABLE) relating the table to the
symbol naming it. The ID of a translation table is an index into this vector. */);
Vtranslation_table_vector = Fmake_vector (make_number (16), Qnil);
Vtranslation_table_vector = Fmake_vector (make_fixnum (16), Qnil);
DEFVAR_LISP ("auto-fill-chars", Vauto_fill_chars,
doc: /*
@ -1137,26 +1137,26 @@ Such characters have value t in this table. */);
DEFVAR_LISP ("char-width-table", Vchar_width_table,
doc: /*
A char-table for width (columns) of each character. */);
Vchar_width_table = Fmake_char_table (Qnil, make_number (1));
char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_number (4));
Vchar_width_table = Fmake_char_table (Qnil, make_fixnum (1));
char_table_set_range (Vchar_width_table, 0x80, 0x9F, make_fixnum (4));
char_table_set_range (Vchar_width_table, MAX_5_BYTE_CHAR + 1, MAX_CHAR,
make_number (4));
make_fixnum (4));
DEFVAR_LISP ("printable-chars", Vprintable_chars,
doc: /* A char-table for each printable character. */);
Vprintable_chars = Fmake_char_table (Qnil, Qnil);
Fset_char_table_range (Vprintable_chars,
Fcons (make_number (32), make_number (126)), Qt);
Fcons (make_fixnum (32), make_fixnum (126)), Qt);
Fset_char_table_range (Vprintable_chars,
Fcons (make_number (160),
make_number (MAX_5_BYTE_CHAR)), Qt);
Fcons (make_fixnum (160),
make_fixnum (MAX_5_BYTE_CHAR)), Qt);
DEFVAR_LISP ("char-script-table", Vchar_script_table,
doc: /* Char table of script symbols.
It has one extra slot whose value is a list of script symbols. */);
DEFSYM (Qchar_script_table, "char-script-table");
Fput (Qchar_script_table, Qchar_table_extra_slots, make_number (1));
Fput (Qchar_script_table, Qchar_table_extra_slots, make_fixnum (1));
Vchar_script_table = Fmake_char_table (Qchar_script_table, Qnil);
DEFVAR_LISP ("script-representative-chars", Vscript_representative_chars,

8
src/character.h
View file

@ -123,7 +123,7 @@ enum
#define MAX_MULTIBYTE_LENGTH 5
/* Nonzero iff X is a character. */
#define CHARACTERP(x) (NATNUMP (x) && XFASTINT (x) <= MAX_CHAR)
#define CHARACTERP(x) (FIXNATP (x) && XFIXNAT (x) <= MAX_CHAR)
/* Nonzero iff C is valid as a character code. */
#define CHAR_VALID_P(c) UNSIGNED_CMP (c, <=, MAX_CHAR)
@ -559,7 +559,7 @@ enum
/* Return a non-outlandish value for the tab width. */
#define SANE_TAB_WIDTH(buf) \
sanitize_tab_width (XFASTINT (BVAR (buf, tab_width)))
sanitize_tab_width (XFIXNAT (BVAR (buf, tab_width)))
INLINE int
sanitize_tab_width (EMACS_INT width)
{
@ -595,7 +595,7 @@ sanitize_char_width (EMACS_INT width)
#define CHARACTER_WIDTH(c) \
(ASCII_CHAR_P (c) \
? ASCII_CHAR_WIDTH (c) \
: sanitize_char_width (XINT (CHAR_TABLE_REF (Vchar_width_table, c))))
: sanitize_char_width (XFIXNUM (CHAR_TABLE_REF (Vchar_width_table, c))))
/* If C is a variation selector, return the index of the
variation selector (1..256). Otherwise, return 0. */
@ -700,7 +700,7 @@ char_table_translate (Lisp_Object obj, int ch)
eassert (CHAR_VALID_P (ch));
eassert (CHAR_TABLE_P (obj));
obj = CHAR_TABLE_REF (obj, ch);
return CHARACTERP (obj) ? XINT (obj) : ch;
return CHARACTERP (obj) ? XFIXNUM (obj) : ch;
}
#if defined __GNUC__ && !defined __STRICT_ANSI__

284
src/charset.c
View file

@ -261,7 +261,7 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
{
int n = CODE_POINT_TO_INDEX (charset, max_code) + 1;
vec = Fmake_vector (make_number (n), make_number (-1));
vec = Fmake_vector (make_fixnum (n), make_fixnum (-1));
set_charset_attr (charset, charset_decoder, vec);
}
else
@ -340,12 +340,12 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
{
if (charset->method == CHARSET_METHOD_MAP)
for (; from_index < lim_index; from_index++, from_c++)
ASET (vec, from_index, make_number (from_c));
ASET (vec, from_index, make_fixnum (from_c));
else
for (; from_index < lim_index; from_index++, from_c++)
CHAR_TABLE_SET (Vchar_unify_table,
CHARSET_CODE_OFFSET (charset) + from_index,
make_number (from_c));
make_fixnum (from_c));
}
else if (control_flag == 2)
{
@ -357,13 +357,13 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
code = INDEX_TO_CODE_POINT (charset, code);
if (NILP (CHAR_TABLE_REF (table, from_c)))
CHAR_TABLE_SET (table, from_c, make_number (code));
CHAR_TABLE_SET (table, from_c, make_fixnum (code));
}
else
for (; from_index < lim_index; from_index++, from_c++)
{
if (NILP (CHAR_TABLE_REF (table, from_c)))
CHAR_TABLE_SET (table, from_c, make_number (from_index));
CHAR_TABLE_SET (table, from_c, make_fixnum (from_index));
}
}
else if (control_flag == 3)
@ -587,14 +587,14 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont
{
val2 = XCDR (val);
val = XCAR (val);
from = XFASTINT (val);
to = XFASTINT (val2);
from = XFIXNAT (val);
to = XFIXNAT (val2);
}
else
from = to = XFASTINT (val);
from = to = XFIXNAT (val);
val = AREF (vec, i + 1);
CHECK_NATNUM (val);
c = XFASTINT (val);
CHECK_FIXNAT (val);
c = XFIXNAT (val);
if (from < min_code || to > max_code || from > to || c > MAX_CHAR)
continue;
@ -675,11 +675,11 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object),
if (idx >= from_idx && idx <= to_idx)
{
if (NILP (XCAR (range)))
XSETCAR (range, make_number (c));
XSETCAR (range, make_fixnum (c));
}
else if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (c_function)
(*c_function) (arg, range);
else
@ -692,7 +692,7 @@ map_charset_for_dump (void (*c_function) (Lisp_Object, Lisp_Object),
{
if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c));
XSETCDR (range, make_fixnum (c));
if (c_function)
(*c_function) (arg, range);
else
@ -734,7 +734,7 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun
map_charset_for_dump (c_function, function, arg, from, to);
}
range = Fcons (make_number (from_c), make_number (to_c));
range = Fcons (make_fixnum (from_c), make_fixnum (to_c));
if (NILP (function))
(*c_function) (arg, range);
else
@ -757,14 +757,14 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun
int offset;
subset_info = CHARSET_SUBSET (charset);
charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
offset = XINT (AREF (subset_info, 3));
charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0)));
offset = XFIXNUM (AREF (subset_info, 3));
from -= offset;
if (from < XFASTINT (AREF (subset_info, 1)))
from = XFASTINT (AREF (subset_info, 1));
if (from < XFIXNAT (AREF (subset_info, 1)))
from = XFIXNAT (AREF (subset_info, 1));
to -= offset;
if (to > XFASTINT (AREF (subset_info, 2)))
to = XFASTINT (AREF (subset_info, 2));
if (to > XFIXNAT (AREF (subset_info, 2)))
to = XFIXNAT (AREF (subset_info, 2));
map_charset_chars (c_function, function, arg, charset, from, to);
}
else /* i.e. CHARSET_METHOD_SUPERSET */
@ -777,8 +777,8 @@ map_charset_chars (void (*c_function)(Lisp_Object, Lisp_Object), Lisp_Object fun
int offset;
unsigned this_from, this_to;
charset = CHARSET_FROM_ID (XFASTINT (XCAR (XCAR (parents))));
offset = XINT (XCDR (XCAR (parents)));
charset = CHARSET_FROM_ID (XFIXNAT (XCAR (XCAR (parents))));
offset = XFIXNUM (XCDR (XCAR (parents)));
this_from = from > offset ? from - offset : 0;
this_to = to > offset ? to - offset : 0;
if (this_from < CHARSET_MIN_CODE (charset))
@ -811,7 +811,7 @@ range of code points (in CHARSET) of target characters. */)
from = CHARSET_MIN_CODE (cs);
else
{
from = XINT (from_code);
from = XFIXNUM (from_code);
if (from < CHARSET_MIN_CODE (cs))
from = CHARSET_MIN_CODE (cs);
}
@ -819,7 +819,7 @@ range of code points (in CHARSET) of target characters. */)
to = CHARSET_MAX_CODE (cs);
else
{
to = XINT (to_code);
to = XFIXNUM (to_code);
if (to > CHARSET_MAX_CODE (cs))
to = CHARSET_MAX_CODE (cs);
}
@ -854,9 +854,9 @@ usage: (define-charset-internal ...) */)
if (nargs != charset_arg_max)
Fsignal (Qwrong_number_of_arguments,
Fcons (intern ("define-charset-internal"),
make_number (nargs)));
make_fixnum (nargs)));
attrs = Fmake_vector (make_number (charset_attr_max), Qnil);
attrs = Fmake_vector (make_fixnum (charset_attr_max), Qnil);
CHECK_SYMBOL (args[charset_arg_name]);
ASET (attrs, charset_name, args[charset_arg_name]);
@ -867,12 +867,12 @@ usage: (define-charset-internal ...) */)
Lisp_Object min_byte_obj, max_byte_obj;
int min_byte, max_byte;
min_byte_obj = Faref (val, make_number (i * 2));
max_byte_obj = Faref (val, make_number (i * 2 + 1));
min_byte_obj = Faref (val, make_fixnum (i * 2));
max_byte_obj = Faref (val, make_fixnum (i * 2 + 1));
CHECK_RANGED_INTEGER (min_byte_obj, 0, 255);
min_byte = XINT (min_byte_obj);
min_byte = XFIXNUM (min_byte_obj);
CHECK_RANGED_INTEGER (max_byte_obj, min_byte, 255);
max_byte = XINT (max_byte_obj);
max_byte = XFIXNUM (max_byte_obj);
charset.code_space[i * 4] = min_byte;
charset.code_space[i * 4 + 1] = max_byte;
charset.code_space[i * 4 + 2] = max_byte - min_byte + 1;
@ -890,7 +890,7 @@ usage: (define-charset-internal ...) */)
else
{
CHECK_RANGED_INTEGER (val, 1, 4);
charset.dimension = XINT (val);
charset.dimension = XFIXNUM (val);
}
charset.code_linear_p
@ -970,10 +970,10 @@ usage: (define-charset-internal ...) */)
charset.iso_final = -1;
else
{
CHECK_NUMBER (val);
if (XINT (val) < '0' || XINT (val) > 127)
error ("Invalid iso-final-char: %"pI"d", XINT (val));
charset.iso_final = XINT (val);
CHECK_FIXNUM (val);
if (XFIXNUM (val) < '0' || XFIXNUM (val) > 127)
error ("Invalid iso-final-char: %"pI"d", XFIXNUM (val));
charset.iso_final = XFIXNUM (val);
}
val = args[charset_arg_iso_revision];
@ -982,7 +982,7 @@ usage: (define-charset-internal ...) */)
else
{
CHECK_RANGED_INTEGER (val, -1, 63);
charset.iso_revision = XINT (val);
charset.iso_revision = XFIXNUM (val);
}
val = args[charset_arg_emacs_mule_id];
@ -990,10 +990,10 @@ usage: (define-charset-internal ...) */)
charset.emacs_mule_id = -1;
else
{
CHECK_NATNUM (val);
if ((XINT (val) > 0 && XINT (val) <= 128) || XINT (val) >= 256)
error ("Invalid emacs-mule-id: %"pI"d", XINT (val));
charset.emacs_mule_id = XINT (val);
CHECK_FIXNAT (val);
if ((XFIXNUM (val) > 0 && XFIXNUM (val) <= 128) || XFIXNUM (val) >= 256)
error ("Invalid emacs-mule-id: %"pI"d", XFIXNUM (val));
charset.emacs_mule_id = XFIXNUM (val);
}
charset.ascii_compatible_p = ! NILP (args[charset_arg_ascii_compatible_p]);
@ -1010,7 +1010,7 @@ usage: (define-charset-internal ...) */)
CHECK_CHARACTER (val);
charset.method = CHARSET_METHOD_OFFSET;
charset.code_offset = XINT (val);
charset.code_offset = XFIXNUM (val);
i = CODE_POINT_TO_INDEX (&charset, charset.max_code);
if (MAX_CHAR - charset.code_offset < i)
@ -1043,14 +1043,14 @@ usage: (define-charset-internal ...) */)
val = args[charset_arg_subset];
parent = Fcar (val);
CHECK_CHARSET_GET_CHARSET (parent, parent_charset);
parent_min_code = Fnth (make_number (1), val);
CHECK_NATNUM (parent_min_code);
parent_max_code = Fnth (make_number (2), val);
CHECK_NATNUM (parent_max_code);
parent_code_offset = Fnth (make_number (3), val);
CHECK_NUMBER (parent_code_offset);
parent_min_code = Fnth (make_fixnum (1), val);
CHECK_FIXNAT (parent_min_code);
parent_max_code = Fnth (make_fixnum (2), val);
CHECK_FIXNAT (parent_max_code);
parent_code_offset = Fnth (make_fixnum (3), val);
CHECK_FIXNUM (parent_code_offset);
val = make_uninit_vector (4);
ASET (val, 0, make_number (parent_charset->id));
ASET (val, 0, make_fixnum (parent_charset->id));
ASET (val, 1, parent_min_code);
ASET (val, 2, parent_max_code);
ASET (val, 3, parent_code_offset);
@ -1089,14 +1089,14 @@ usage: (define-charset-internal ...) */)
cdr_part = XCDR (elt);
CHECK_CHARSET_GET_ID (car_part, this_id);
CHECK_TYPE_RANGED_INTEGER (int, cdr_part);
offset = XINT (cdr_part);
offset = XFIXNUM (cdr_part);
}
else
{
CHECK_CHARSET_GET_ID (elt, this_id);
offset = 0;
}
XSETCAR (val, Fcons (make_number (this_id), make_number (offset)));
XSETCAR (val, Fcons (make_fixnum (this_id), make_fixnum (offset)));
this_charset = CHARSET_FROM_ID (this_id);
if (charset.min_char > this_charset->min_char)
@ -1123,7 +1123,7 @@ usage: (define-charset-internal ...) */)
if (charset.hash_index >= 0)
{
new_definition_p = 0;
id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
id = XFIXNAT (CHARSET_SYMBOL_ID (args[charset_arg_name]));
set_hash_value_slot (hash_table, charset.hash_index, attrs);
}
else
@ -1158,7 +1158,7 @@ usage: (define-charset-internal ...) */)
new_definition_p = 1;
}
ASET (attrs, charset_id, make_number (id));
ASET (attrs, charset_id, make_fixnum (id));
charset.id = id;
charset_table[id] = charset;
@ -1174,7 +1174,7 @@ usage: (define-charset-internal ...) */)
charset.iso_final) = id;
if (new_definition_p)
Viso_2022_charset_list = nconc2 (Viso_2022_charset_list,
list1 (make_number (id)));
list1 (make_fixnum (id)));
if (ISO_CHARSET_TABLE (1, 0, 'J') == id)
charset_jisx0201_roman = id;
else if (ISO_CHARSET_TABLE (2, 0, '@') == id)
@ -1194,7 +1194,7 @@ usage: (define-charset-internal ...) */)
emacs_mule_bytes[charset.emacs_mule_id] = charset.dimension + 2;
if (new_definition_p)
Vemacs_mule_charset_list = nconc2 (Vemacs_mule_charset_list,
list1 (make_number (id)));
list1 (make_fixnum (id)));
}
if (new_definition_p)
@ -1202,29 +1202,29 @@ usage: (define-charset-internal ...) */)
Vcharset_list = Fcons (args[charset_arg_name], Vcharset_list);
if (charset.supplementary_p)
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
list1 (make_number (id)));
list1 (make_fixnum (id)));
else
{
Lisp_Object tail;
for (tail = Vcharset_ordered_list; CONSP (tail); tail = XCDR (tail))
{
struct charset *cs = CHARSET_FROM_ID (XINT (XCAR (tail)));
struct charset *cs = CHARSET_FROM_ID (XFIXNUM (XCAR (tail)));
if (cs->supplementary_p)
break;
}
if (EQ (tail, Vcharset_ordered_list))
Vcharset_ordered_list = Fcons (make_number (id),
Vcharset_ordered_list = Fcons (make_fixnum (id),
Vcharset_ordered_list);
else if (NILP (tail))
Vcharset_ordered_list = nconc2 (Vcharset_ordered_list,
list1 (make_number (id)));
list1 (make_fixnum (id)));
else
{
val = Fcons (XCAR (tail), XCDR (tail));
XSETCDR (tail, val);
XSETCAR (tail, make_number (id));
XSETCAR (tail, make_fixnum (id));
}
}
charset_ordered_list_tick++;
@ -1254,22 +1254,22 @@ define_charset_internal (Lisp_Object name,
int i;
args[charset_arg_name] = name;
args[charset_arg_dimension] = make_number (dimension);
args[charset_arg_dimension] = make_fixnum (dimension);
val = make_uninit_vector (8);
for (i = 0; i < 8; i++)
ASET (val, i, make_number (code_space[i]));
ASET (val, i, make_fixnum (code_space[i]));
args[charset_arg_code_space] = val;
args[charset_arg_min_code] = make_number (min_code);
args[charset_arg_max_code] = make_number (max_code);
args[charset_arg_min_code] = make_fixnum (min_code);
args[charset_arg_max_code] = make_fixnum (max_code);
args[charset_arg_iso_final]
= (iso_final < 0 ? Qnil : make_number (iso_final));
args[charset_arg_iso_revision] = make_number (iso_revision);
= (iso_final < 0 ? Qnil : make_fixnum (iso_final));
args[charset_arg_iso_revision] = make_fixnum (iso_revision);
args[charset_arg_emacs_mule_id]
= (emacs_mule_id < 0 ? Qnil : make_number (emacs_mule_id));
= (emacs_mule_id < 0 ? Qnil : make_fixnum (emacs_mule_id));
args[charset_arg_ascii_compatible_p] = ascii_compatible ? Qt : Qnil;
args[charset_arg_supplementary_p] = supplementary ? Qt : Qnil;
args[charset_arg_invalid_code] = Qnil;
args[charset_arg_code_offset] = make_number (code_offset);
args[charset_arg_code_offset] = make_fixnum (code_offset);
args[charset_arg_map] = Qnil;
args[charset_arg_subset] = Qnil;
args[charset_arg_superset] = Qnil;
@ -1293,7 +1293,7 @@ define_charset_internal (Lisp_Object name,
args[charset_arg_code_offset]);
Fdefine_charset_internal (charset_arg_max, args);
return XINT (CHARSET_SYMBOL_ID (name));
return XFIXNUM (CHARSET_SYMBOL_ID (name));
}
@ -1396,19 +1396,19 @@ static bool
check_iso_charset_parameter (Lisp_Object dimension, Lisp_Object chars,
Lisp_Object final_char)
{
CHECK_NUMBER (dimension);
CHECK_NUMBER (chars);
CHECK_FIXNUM (dimension);
CHECK_FIXNUM (chars);
CHECK_CHARACTER (final_char);
if (! (1 <= XINT (dimension) && XINT (dimension) <= 3))
if (! (1 <= XFIXNUM (dimension) && XFIXNUM (dimension) <= 3))
error ("Invalid DIMENSION %"pI"d, it should be 1, 2, or 3",
XINT (dimension));
XFIXNUM (dimension));
bool chars_flag = XINT (chars) == 96;
if (! (chars_flag || XINT (chars) == 94))
error ("Invalid CHARS %"pI"d, it should be 94 or 96", XINT (chars));
bool chars_flag = XFIXNUM (chars) == 96;
if (! (chars_flag || XFIXNUM (chars) == 94))
error ("Invalid CHARS %"pI"d, it should be 94 or 96", XFIXNUM (chars));
int final_ch = XFASTINT (final_char);
int final_ch = XFIXNAT (final_char);
if (! ('0' <= final_ch && final_ch <= '~'))
error ("Invalid FINAL-CHAR `%c', it should be `0'..`~'", final_ch);
@ -1428,10 +1428,10 @@ return nil. */)
(Lisp_Object dimension, Lisp_Object chars)
{
bool chars_flag = check_iso_charset_parameter (dimension, chars,
make_number ('0'));
make_fixnum ('0'));
for (int final_char = '0'; final_char <= '?'; final_char++)
if (ISO_CHARSET_TABLE (XINT (dimension), chars_flag, final_char) < 0)
return make_number (final_char);
if (ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag, final_char) < 0)
return make_fixnum (final_char);
return Qnil;
}
@ -1449,7 +1449,7 @@ if CHARSET is designated instead. */)
CHECK_CHARSET_GET_ID (charset, id);
bool chars_flag = check_iso_charset_parameter (dimension, chars, final_char);
ISO_CHARSET_TABLE (XINT (dimension), chars_flag, XFASTINT (final_char)) = id;
ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag, XFIXNAT (final_char)) = id;
return Qnil;
}
@ -1550,8 +1550,8 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
validate_region (&beg, &end);
from = XFASTINT (beg);
stop = to = XFASTINT (end);
from = XFIXNAT (beg);
stop = to = XFIXNAT (end);
if (from < GPT && GPT < to)
{
@ -1563,7 +1563,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
from_byte = CHAR_TO_BYTE (from);
charsets = Fmake_vector (make_number (charset_table_used), Qnil);
charsets = Fmake_vector (make_fixnum (charset_table_used), Qnil);
while (1)
{
find_charsets_in_text (BYTE_POS_ADDR (from_byte), stop - from,
@ -1600,7 +1600,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */)
CHECK_STRING (str);
charsets = Fmake_vector (make_number (charset_table_used), Qnil);
charsets = Fmake_vector (make_fixnum (charset_table_used), Qnil);
find_charsets_in_text (SDATA (str), SCHARS (str), SBYTES (str),
charsets, table,
STRING_MULTIBYTE (str));
@ -1621,8 +1621,8 @@ maybe_unify_char (int c, Lisp_Object val)
{
struct charset *charset;
if (INTEGERP (val))
return XFASTINT (val);
if (FIXNUMP (val))
return XFIXNAT (val);
if (NILP (val))
return c;
@ -1638,7 +1638,7 @@ maybe_unify_char (int c, Lisp_Object val)
{
val = CHAR_TABLE_REF (Vchar_unify_table, c);
if (! NILP (val))
c = XFASTINT (val);
c = XFIXNAT (val);
}
else
{
@ -1672,10 +1672,10 @@ decode_char (struct charset *charset, unsigned int code)
Lisp_Object subset_info;
subset_info = CHARSET_SUBSET (charset);
charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
code -= XINT (AREF (subset_info, 3));
if (code < XFASTINT (AREF (subset_info, 1))
|| code > XFASTINT (AREF (subset_info, 2)))
charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0)));
code -= XFIXNUM (AREF (subset_info, 3));
if (code < XFIXNAT (AREF (subset_info, 1))
|| code > XFIXNAT (AREF (subset_info, 2)))
c = -1;
else
c = DECODE_CHAR (charset, code);
@ -1688,8 +1688,8 @@ decode_char (struct charset *charset, unsigned int code)
c = -1;
for (; CONSP (parents); parents = XCDR (parents))
{
int id = XINT (XCAR (XCAR (parents)));
int code_offset = XINT (XCDR (XCAR (parents)));
int id = XFIXNUM (XCAR (XCAR (parents)));
int code_offset = XFIXNUM (XCDR (XCAR (parents)));
unsigned this_code = code - code_offset;
charset = CHARSET_FROM_ID (id);
@ -1714,7 +1714,7 @@ decode_char (struct charset *charset, unsigned int code)
decoder = CHARSET_DECODER (charset);
}
if (VECTORP (decoder))
c = XINT (AREF (decoder, char_index));
c = XFIXNUM (AREF (decoder, char_index));
else
c = GET_TEMP_CHARSET_WORK_DECODER (char_index);
}
@ -1762,8 +1762,8 @@ encode_char (struct charset *charset, int c)
{
Lisp_Object deunified = CHAR_TABLE_REF (deunifier, c);
if (INTEGERP (deunified))
code_index = XINT (deunified);
if (FIXNUMP (deunified))
code_index = XFIXNUM (deunified);
}
else
{
@ -1779,13 +1779,13 @@ encode_char (struct charset *charset, int c)
struct charset *this_charset;
subset_info = CHARSET_SUBSET (charset);
this_charset = CHARSET_FROM_ID (XFASTINT (AREF (subset_info, 0)));
this_charset = CHARSET_FROM_ID (XFIXNAT (AREF (subset_info, 0)));
code = ENCODE_CHAR (this_charset, c);
if (code == CHARSET_INVALID_CODE (this_charset)
|| code < XFASTINT (AREF (subset_info, 1))
|| code > XFASTINT (AREF (subset_info, 2)))
|| code < XFIXNAT (AREF (subset_info, 1))
|| code > XFIXNAT (AREF (subset_info, 2)))
return CHARSET_INVALID_CODE (charset);
code += XINT (AREF (subset_info, 3));
code += XFIXNUM (AREF (subset_info, 3));
return code;
}
@ -1796,8 +1796,8 @@ encode_char (struct charset *charset, int c)
parents = CHARSET_SUPERSET (charset);
for (; CONSP (parents); parents = XCDR (parents))
{
int id = XINT (XCAR (XCAR (parents)));
int code_offset = XINT (XCDR (XCAR (parents)));
int id = XFIXNUM (XCAR (XCAR (parents)));
int code_offset = XFIXNUM (XCDR (XCAR (parents)));
struct charset *this_charset = CHARSET_FROM_ID (id);
code = ENCODE_CHAR (this_charset, c);
@ -1827,7 +1827,7 @@ encode_char (struct charset *charset, int c)
val = CHAR_TABLE_REF (encoder, c);
if (NILP (val))
return CHARSET_INVALID_CODE (charset);
code = XINT (val);
code = XFIXNUM (val);
if (! CHARSET_COMPACT_CODES_P (charset))
code = INDEX_TO_CODE_POINT (charset, code);
}
@ -1863,7 +1863,7 @@ CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
code = cons_to_unsigned (code_point, UINT_MAX);
charsetp = CHARSET_FROM_ID (id);
c = DECODE_CHAR (charsetp, code);
return (c >= 0 ? make_number (c) : Qnil);
return (c >= 0 ? make_fixnum (c) : Qnil);
}
@ -1878,7 +1878,7 @@ Return nil if CHARSET doesn't include CH. */)
CHECK_CHARSET_GET_ID (charset, id);
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
c = XFIXNAT (ch);
charsetp = CHARSET_FROM_ID (id);
code = ENCODE_CHAR (charsetp, c);
if (code == CHARSET_INVALID_CODE (charsetp))
@ -1910,10 +1910,10 @@ is specified. */)
? 0 : CHARSET_MIN_CODE (charsetp));
else
{
CHECK_NATNUM (code1);
if (XFASTINT (code1) >= 0x100)
args_out_of_range (make_number (0xFF), code1);
code = XFASTINT (code1);
CHECK_FIXNAT (code1);
if (XFIXNAT (code1) >= 0x100)
args_out_of_range (make_fixnum (0xFF), code1);
code = XFIXNAT (code1);
if (dimension > 1)
{
@ -1922,10 +1922,10 @@ is specified. */)
code |= charsetp->code_space[(dimension - 2) * 4];
else
{
CHECK_NATNUM (code2);
if (XFASTINT (code2) >= 0x100)
args_out_of_range (make_number (0xFF), code2);
code |= XFASTINT (code2);
CHECK_FIXNAT (code2);
if (XFIXNAT (code2) >= 0x100)
args_out_of_range (make_fixnum (0xFF), code2);
code |= XFIXNAT (code2);
}
if (dimension > 2)
@ -1935,10 +1935,10 @@ is specified. */)
code |= charsetp->code_space[(dimension - 3) * 4];
else
{
CHECK_NATNUM (code3);
if (XFASTINT (code3) >= 0x100)
args_out_of_range (make_number (0xFF), code3);
code |= XFASTINT (code3);
CHECK_FIXNAT (code3);
if (XFIXNAT (code3) >= 0x100)
args_out_of_range (make_fixnum (0xFF), code3);
code |= XFIXNAT (code3);
}
if (dimension > 3)
@ -1948,10 +1948,10 @@ is specified. */)
code |= charsetp->code_space[0];
else
{
CHECK_NATNUM (code4);
if (XFASTINT (code4) >= 0x100)
args_out_of_range (make_number (0xFF), code4);
code |= XFASTINT (code4);
CHECK_FIXNAT (code4);
if (XFIXNAT (code4) >= 0x100)
args_out_of_range (make_fixnum (0xFF), code4);
code |= XFIXNAT (code4);
}
}
}
@ -1963,7 +1963,7 @@ is specified. */)
c = DECODE_CHAR (charsetp, code);
if (c < 0)
error ("Invalid code(s)");
return make_number (c);
return make_fixnum (c);
}
@ -1983,7 +1983,7 @@ char_charset (int c, Lisp_Object charset_list, unsigned int *code_return)
while (CONSP (charset_list))
{
struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (charset_list)));
struct charset *charset = CHARSET_FROM_ID (XFIXNUM (XCAR (charset_list)));
unsigned code = ENCODE_CHAR (charset, c);
if (code != CHARSET_INVALID_CODE (charset))
@ -2018,7 +2018,7 @@ CH in the charset. */)
Lisp_Object val;
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
c = XFIXNAT (ch);
charset = CHAR_CHARSET (c);
if (! charset)
emacs_abort ();
@ -2028,7 +2028,7 @@ CH in the charset. */)
dimension = CHARSET_DIMENSION (charset);
for (val = Qnil; dimension > 0; dimension--)
{
val = Fcons (make_number (code & 0xFF), val);
val = Fcons (make_fixnum (code & 0xFF), val);
code >>= 8;
}
return Fcons (CHARSET_NAME (charset), val);
@ -2048,12 +2048,12 @@ that case, find the charset from what supported by that coding system. */)
CHECK_CHARACTER (ch);
if (NILP (restriction))
charset = CHAR_CHARSET (XINT (ch));
charset = CHAR_CHARSET (XFIXNUM (ch));
else
{
if (CONSP (restriction))
{
int c = XFASTINT (ch);
int c = XFIXNAT (ch);
for (; CONSP (restriction); restriction = XCDR (restriction))
{
@ -2066,7 +2066,7 @@ that case, find the charset from what supported by that coding system. */)
return Qnil;
}
restriction = coding_system_charset_list (restriction);
charset = char_charset (XINT (ch), restriction, NULL);
charset = char_charset (XFIXNUM (ch), restriction, NULL);
if (! charset)
return Qnil;
}
@ -2085,9 +2085,9 @@ If POS is out of range, the value is nil. */)
struct charset *charset;
ch = Fchar_after (pos);
if (! INTEGERP (ch))
if (! FIXNUMP (ch))
return ch;
charset = CHAR_CHARSET (XINT (ch));
charset = CHAR_CHARSET (XFIXNUM (ch));
return (CHARSET_NAME (charset));
}
@ -2104,8 +2104,8 @@ DIMENSION, CHARS, and FINAL-CHAR. */)
(Lisp_Object dimension, Lisp_Object chars, Lisp_Object final_char)
{
bool chars_flag = check_iso_charset_parameter (dimension, chars, final_char);
int id = ISO_CHARSET_TABLE (XINT (dimension), chars_flag,
XFASTINT (final_char));
int id = ISO_CHARSET_TABLE (XFIXNUM (dimension), chars_flag,
XFIXNAT (final_char));
return (id >= 0 ? CHARSET_NAME (CHARSET_FROM_ID (id)) : Qnil);
}
@ -2139,11 +2139,11 @@ HIGHESTP non-nil means just return the highest priority one. */)
Lisp_Object val = Qnil, list = Vcharset_ordered_list;
if (!NILP (highestp))
return CHARSET_NAME (CHARSET_FROM_ID (XINT (Fcar (list))));
return CHARSET_NAME (CHARSET_FROM_ID (XFIXNUM (Fcar (list))));
while (!NILP (list))
{
val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XINT (XCAR (list)))), val);
val = Fcons (CHARSET_NAME (CHARSET_FROM_ID (XFIXNUM (XCAR (list)))), val);
list = XCDR (list);
}
return Fnreverse (val);
@ -2165,10 +2165,10 @@ usage: (set-charset-priority &rest charsets) */)
for (i = 0; i < nargs; i++)
{
CHECK_CHARSET_GET_ID (args[i], id);
if (! NILP (Fmemq (make_number (id), old_list)))
if (! NILP (Fmemq (make_fixnum (id), old_list)))
{
old_list = Fdelq (make_number (id), old_list);
new_head = Fcons (make_number (id), new_head);
old_list = Fdelq (make_fixnum (id), old_list);
new_head = Fcons (make_fixnum (id), new_head);
}
}
Vcharset_non_preferred_head = old_list;
@ -2186,7 +2186,7 @@ usage: (set-charset-priority &rest charsets) */)
list_emacs_mule = Fcons (XCAR (old_list), list_emacs_mule);
if (charset_unibyte < 0)
{
struct charset *charset = CHARSET_FROM_ID (XINT (XCAR (old_list)));
struct charset *charset = CHARSET_FROM_ID (XFIXNUM (XCAR (old_list)));
if (CHARSET_DIMENSION (charset) == 1
&& CHARSET_ASCII_COMPATIBLE_P (charset)
@ -2211,7 +2211,7 @@ Return charset identification number of CHARSET. */)
int id;
CHECK_CHARSET_GET_ID (charset, id);
return make_number (id);
return make_fixnum (id);
}
struct charset_sort_data
@ -2237,7 +2237,7 @@ See also `charset-priority-list' and `set-charset-priority'. */)
(Lisp_Object charsets)
{
Lisp_Object len = Flength (charsets);
ptrdiff_t n = XFASTINT (len), i, j;
ptrdiff_t n = XFIXNAT (len), i, j;
int done;
Lisp_Object tail, elt, attrs;
struct charset_sort_data *sort_data;
@ -2252,7 +2252,7 @@ See also `charset-priority-list' and `set-charset-priority'. */)
elt = XCAR (tail);
CHECK_CHARSET_GET_ATTR (elt, attrs);
sort_data[i].charset = elt;
sort_data[i].id = id = XINT (CHARSET_ATTR_ID (attrs));
sort_data[i].id = id = XFIXNUM (CHARSET_ATTR_ID (attrs));
if (id < min_id)
min_id = id;
if (id > max_id)
@ -2262,7 +2262,7 @@ See also `charset-priority-list' and `set-charset-priority'. */)
done < n && CONSP (tail); tail = XCDR (tail), i++)
{
elt = XCAR (tail);
id = XFASTINT (elt);
id = XFIXNAT (elt);
if (id >= min_id && id <= max_id)
for (j = 0; j < n; j++)
if (sort_data[j].id == id)

6
src/charset.h
View file

@ -355,7 +355,7 @@ set_charset_attr (struct charset *charset, enum charset_attr_index idx,
\
if (! SYMBOLP (x) || (idx = CHARSET_SYMBOL_HASH_INDEX (x)) < 0) \
wrong_type_argument (Qcharsetp, (x)); \
id = XINT (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \
id = XFIXNUM (AREF (HASH_VALUE (XHASH_TABLE (Vcharset_hash_table), idx), \
charset_id)); \
} while (false)
@ -416,7 +416,7 @@ extern Lisp_Object Vchar_charset_set;
: (charset)->method == CHARSET_METHOD_MAP \
? (((charset)->code_linear_p \
&& VECTORP (CHARSET_DECODER (charset))) \
? XINT (AREF (CHARSET_DECODER (charset), \
? XFIXNUM (AREF (CHARSET_DECODER (charset), \
(code) - (charset)->min_code)) \
: decode_char ((charset), (code))) \
: decode_char ((charset), (code)))
@ -447,7 +447,7 @@ extern Lisp_Object charset_work;
? (charset_work = CHAR_TABLE_REF (CHARSET_ENCODER (charset), c), \
(NILP (charset_work) \
? (charset)->invalid_code \
: (unsigned) XFASTINT (charset_work))) \
: (unsigned) XFIXNAT (charset_work))) \
: encode_char (charset, c)) \
: encode_char (charset, c))))

96
src/chartab.c
View file

@ -118,14 +118,14 @@ the char-table has no extra slot. */)
n_extras = 0;
else
{
CHECK_NATNUM (n);
if (XINT (n) > 10)
CHECK_FIXNAT (n);
if (XFIXNUM (n) > 10)
args_out_of_range (n, Qnil);
n_extras = XINT (n);
n_extras = XFIXNUM (n);
}
size = CHAR_TABLE_STANDARD_SLOTS + n_extras;
vector = Fmake_vector (make_number (size), init);
vector = Fmake_vector (make_fixnum (size), init);
XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
set_char_table_parent (vector, Qnil);
set_char_table_purpose (vector, purpose);
@ -188,7 +188,7 @@ copy_char_table (Lisp_Object table)
int size = PVSIZE (table);
int i;
copy = Fmake_vector (make_number (size), Qnil);
copy = Fmake_vector (make_fixnum (size), Qnil);
XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
set_char_table_defalt (copy, XCHAR_TABLE (table)->defalt);
set_char_table_parent (copy, XCHAR_TABLE (table)->parent);
@ -571,12 +571,12 @@ DEFUN ("char-table-extra-slot", Fchar_table_extra_slot, Schar_table_extra_slot,
(Lisp_Object char_table, Lisp_Object n)
{
CHECK_CHAR_TABLE (char_table);
CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
CHECK_FIXNUM (n);
if (XFIXNUM (n) < 0
|| XFIXNUM (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
return XCHAR_TABLE (char_table)->extras[XINT (n)];
return XCHAR_TABLE (char_table)->extras[XFIXNUM (n)];
}
DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
@ -586,12 +586,12 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot,
(Lisp_Object char_table, Lisp_Object n, Lisp_Object value)
{
CHECK_CHAR_TABLE (char_table);
CHECK_NUMBER (n);
if (XINT (n) < 0
|| XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
CHECK_FIXNUM (n);
if (XFIXNUM (n) < 0
|| XFIXNUM (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table)))
args_out_of_range (char_table, n);
set_char_table_extras (char_table, XINT (n), value);
set_char_table_extras (char_table, XFIXNUM (n), value);
return value;
}
@ -608,15 +608,15 @@ a cons of character codes (for characters in the range), or a character code. *
if (NILP (range))
val = XCHAR_TABLE (char_table)->defalt;
else if (CHARACTERP (range))
val = CHAR_TABLE_REF (char_table, XFASTINT (range));
val = CHAR_TABLE_REF (char_table, XFIXNAT (range));
else if (CONSP (range))
{
int from, to;
CHECK_CHARACTER_CAR (range);
CHECK_CHARACTER_CDR (range);
from = XFASTINT (XCAR (range));
to = XFASTINT (XCDR (range));
from = XFIXNAT (XCAR (range));
to = XFIXNAT (XCDR (range));
val = char_table_ref_and_range (char_table, from, &from, &to);
/* Not yet implemented. */
}
@ -645,13 +645,13 @@ or a character code. Return VALUE. */)
else if (NILP (range))
set_char_table_defalt (char_table, value);
else if (CHARACTERP (range))
char_table_set (char_table, XINT (range), value);
char_table_set (char_table, XFIXNUM (range), value);
else if (CONSP (range))
{
CHECK_CHARACTER_CAR (range);
CHECK_CHARACTER_CDR (range);
char_table_set_range (char_table,
XINT (XCAR (range)), XINT (XCDR (range)), value);
XFIXNUM (XCAR (range)), XFIXNUM (XCDR (range)), value);
}
else
error ("Invalid RANGE argument to `set-char-table-range'");
@ -742,7 +742,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
int min_char, max_char;
/* Number of characters covered by one element of TABLE. */
int chars_in_block;
int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range));
int i, c;
bool is_uniprop = UNIPROP_TABLE_P (top);
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top);
@ -783,7 +783,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
if (SUB_CHAR_TABLE_P (this))
{
if (to >= nextc)
XSETCDR (range, make_number (nextc - 1));
XSETCDR (range, make_fixnum (nextc - 1));
val = map_sub_char_table (c_function, function, this, arg,
val, range, top);
}
@ -807,7 +807,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
set_char_table_parent (parent, Qnil);
val = CHAR_TABLE_REF (parent, from);
set_char_table_parent (parent, temp);
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
val = map_sub_char_table (c_function, function,
parent, arg, val, range,
parent);
@ -817,7 +817,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
}
if (! NILP (val) && different_value)
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (EQ (XCAR (range), XCDR (range)))
{
if (c_function)
@ -843,10 +843,10 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
}
val = this;
from = c;
XSETCAR (range, make_number (c));
XSETCAR (range, make_fixnum (c));
}
}
XSETCDR (range, make_number (to));
XSETCDR (range, make_fixnum (to));
}
return val;
}
@ -864,7 +864,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
Lisp_Object range, val, parent;
uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table);
range = Fcons (make_number (0), make_number (MAX_CHAR));
range = Fcons (make_fixnum (0), make_fixnum (MAX_CHAR));
parent = XCHAR_TABLE (table)->parent;
val = XCHAR_TABLE (table)->ascii;
@ -878,7 +878,7 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object),
while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent))
{
Lisp_Object temp;
int from = XINT (XCAR (range));
int from = XFIXNUM (XCAR (range));
parent = XCHAR_TABLE (table)->parent;
temp = XCHAR_TABLE (parent)->parent;
@ -957,7 +957,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
{
if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (c_function)
(*c_function) (arg, range);
else
@ -980,7 +980,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
{
if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (c_function)
(*c_function) (arg, range);
else
@ -991,7 +991,7 @@ map_sub_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
else
{
if (NILP (XCAR (range)))
XSETCAR (range, make_number (c));
XSETCAR (range, make_fixnum (c));
}
}
}
@ -1041,7 +1041,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
{
if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (c_function)
(*c_function) (arg, range);
else
@ -1052,7 +1052,7 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object),
}
if (! NILP (XCAR (range)))
{
XSETCDR (range, make_number (c - 1));
XSETCDR (range, make_fixnum (c - 1));
if (c_function)
(*c_function) (arg, range);
else
@ -1125,7 +1125,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
{
int v = STRING_CHAR_ADVANCE (p);
set_sub_char_table_contents
(sub, idx++, v > 0 ? make_number (v) : Qnil);
(sub, idx++, v > 0 ? make_fixnum (v) : Qnil);
}
}
else if (*p == 2)
@ -1150,7 +1150,7 @@ uniprop_table_uncompress (Lisp_Object table, int idx)
}
}
while (count-- > 0)
set_sub_char_table_contents (sub, idx++, make_number (v));
set_sub_char_table_contents (sub, idx++, make_fixnum (v));
}
}
/* It seems that we don't need this function because C code won't need
@ -1174,8 +1174,8 @@ uniprop_decode_value_run_length (Lisp_Object table, Lisp_Object value)
{
Lisp_Object valvec = XCHAR_TABLE (table)->extras[4];
if (XINT (value) >= 0 && XINT (value) < ASIZE (valvec))
value = AREF (valvec, XINT (value));
if (XFIXNUM (value) >= 0 && XFIXNUM (value) < ASIZE (valvec))
value = AREF (valvec, XFIXNUM (value));
}
return value;
}
@ -1192,9 +1192,9 @@ uniprop_get_decoder (Lisp_Object table)
{
EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[1]))
if (! FIXNUMP (XCHAR_TABLE (table)->extras[1]))
return NULL;
i = XINT (XCHAR_TABLE (table)->extras[1]);
i = XFIXNUM (XCHAR_TABLE (table)->extras[1]);
if (i < 0 || i >= uniprop_decoder_count)
return NULL;
return uniprop_decoder[i];
@ -1227,7 +1227,7 @@ uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value)
break;
if (i == size)
wrong_type_argument (build_string ("Unicode property value"), value);
return make_number (i);
return make_fixnum (i);
}
@ -1240,17 +1240,17 @@ uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value)
Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents;
int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]);
CHECK_NUMBER (value);
CHECK_FIXNUM (value);
for (i = 0; i < size; i++)
if (EQ (value, value_table[i]))
break;
value = make_number (i);
value = make_fixnum (i);
if (i == size)
set_char_table_extras (table, 4,
CALLN (Fvconcat,
XCHAR_TABLE (table)->extras[4],
Fmake_vector (make_number (1), value)));
return make_number (i);
Fmake_vector (make_fixnum (1), value)));
return make_fixnum (i);
}
static uniprop_encoder_t uniprop_encoder[] =
@ -1267,9 +1267,9 @@ uniprop_get_encoder (Lisp_Object table)
{
EMACS_INT i;
if (! INTEGERP (XCHAR_TABLE (table)->extras[2]))
if (! FIXNUMP (XCHAR_TABLE (table)->extras[2]))
return NULL;
i = XINT (XCHAR_TABLE (table)->extras[2]);
i = XFIXNUM (XCHAR_TABLE (table)->extras[2]);
if (i < 0 || i >= uniprop_encoder_count)
return NULL;
return uniprop_encoder[i];
@ -1300,8 +1300,8 @@ uniprop_table (Lisp_Object prop)
|| ! UNIPROP_TABLE_P (table))
return Qnil;
val = XCHAR_TABLE (table)->extras[1];
if (INTEGERP (val)
? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count)
if (FIXNUMP (val)
? (XFIXNUM (val) < 0 || XFIXNUM (val) >= uniprop_decoder_count)
: ! NILP (val))
return Qnil;
/* Prepare ASCII values in advance for CHAR_TABLE_REF. */
@ -1337,7 +1337,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
CHECK_CHARACTER (ch);
if (! UNIPROP_TABLE_P (char_table))
error ("Invalid Unicode property table");
val = CHAR_TABLE_REF (char_table, XINT (ch));
val = CHAR_TABLE_REF (char_table, XFIXNUM (ch));
decoder = uniprop_get_decoder (char_table);
return (decoder ? decoder (char_table, val) : val);
}
@ -1357,7 +1357,7 @@ CHAR-TABLE must be what returned by `unicode-property-table-internal'. */)
encoder = uniprop_get_encoder (char_table);
if (encoder)
value = encoder (char_table, value);
CHAR_TABLE_SET (char_table, XINT (ch), value);
CHAR_TABLE_SET (char_table, XFIXNUM (ch), value);
return Qnil;
}

62
src/cmds.c
View file

@ -35,9 +35,9 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
doc: /* Return buffer position N characters after (before if N negative) point. */)
(Lisp_Object n)
{
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
return make_number (PT + XINT (n));
return make_fixnum (PT + XFIXNUM (n));
}
/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
@ -45,7 +45,7 @@ DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
static Lisp_Object
move_point (Lisp_Object n, bool forward)
{
/* This used to just set point to point + XINT (n), and then check
/* This used to just set point to point + XFIXNUM (n), and then check
to see if it was within boundaries. But now that SET_PT can
potentially do a lot of stuff (calling entering and exiting
hooks, etcetera), that's not a good approach. So we validate the
@ -56,9 +56,9 @@ move_point (Lisp_Object n, bool forward)
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
new_point = PT + (forward ? XINT (n) : - XINT (n));
new_point = PT + (forward ? XFIXNUM (n) : - XFIXNUM (n));
if (new_point < BEGV)
{
@ -127,8 +127,8 @@ go to its beginning. */)
count = 1;
else
{
CHECK_NUMBER (n);
count = XINT (n);
CHECK_FIXNUM (n);
count = XFIXNUM (n);
}
shortage = scan_newline_from_point (count, &pos, &pos_byte);
@ -142,7 +142,7 @@ go to its beginning. */)
&& (FETCH_BYTE (PT_BYTE - 1) != '\n'))))
shortage--;
return make_number (count <= 0 ? - shortage : shortage);
return make_fixnum (count <= 0 ? - shortage : shortage);
}
DEFUN ("beginning-of-line", Fbeginning_of_line, Sbeginning_of_line, 0, 1, "^p",
@ -162,9 +162,9 @@ instead. For instance, `(forward-line 0)' does the same thing as
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
SET_PT (XINT (Fline_beginning_position (n)));
SET_PT (XFIXNUM (Fline_beginning_position (n)));
return Qnil;
}
@ -187,11 +187,11 @@ to t. */)
if (NILP (n))
XSETFASTINT (n, 1);
else
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
while (1)
{
newpos = XINT (Fline_end_position (n));
newpos = XFIXNUM (Fline_end_position (n));
SET_PT (newpos);
if (PT > newpos
@ -210,7 +210,7 @@ to t. */)
/* If we skipped something intangible
and now we're not really at eol,
keep going. */
n = make_number (1);
n = make_fixnum (1);
else
break;
}
@ -230,15 +230,15 @@ because it respects values of `delete-active-region' and `overwrite-mode'. */)
{
EMACS_INT pos;
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
if (eabs (XINT (n)) < 2)
if (eabs (XFIXNUM (n)) < 2)
call0 (Qundo_auto_amalgamate);
pos = PT + XINT (n);
pos = PT + XFIXNUM (n);
if (NILP (killflag))
{
if (XINT (n) < 0)
if (XFIXNUM (n) < 0)
{
if (pos < BEGV)
xsignal0 (Qbeginning_of_buffer);
@ -274,12 +274,12 @@ a non-nil value for the inserted character. At the end, it runs
`post-self-insert-hook'. */)
(Lisp_Object n)
{
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
if (XINT (n) < 0)
error ("Negative repetition argument %"pI"d", XINT (n));
if (XFIXNUM (n) < 0)
error ("Negative repetition argument %"pI"d", XFIXNUM (n));
if (XFASTINT (n) < 2)
if (XFIXNAT (n) < 2)
call0 (Qundo_auto_amalgamate);
/* Barf if the key that invoked this was not a character. */
@ -287,8 +287,8 @@ a non-nil value for the inserted character. At the end, it runs
bitch_at_user ();
else {
int character = translate_char (Vtranslation_table_for_input,
XINT (last_command_event));
int val = internal_self_insert (character, XFASTINT (n));
XFIXNUM (last_command_event));
int val = internal_self_insert (character, XFIXNAT (n));
if (val == 2)
Fset (Qundo_auto__this_command_amalgamating, Qnil);
frame_make_pointer_invisible (SELECTED_FRAME ());
@ -360,7 +360,7 @@ internal_self_insert (int c, EMACS_INT n)
if (EQ (overwrite, Qoverwrite_mode_binary))
chars_to_delete = min (n, PTRDIFF_MAX);
else if (c != '\n' && c2 != '\n'
&& (cwidth = XFASTINT (Fchar_width (make_number (c)))) != 0)
&& (cwidth = XFIXNAT (Fchar_width (make_fixnum (c)))) != 0)
{
ptrdiff_t pos = PT;
ptrdiff_t pos_byte = PT_BYTE;
@ -378,7 +378,7 @@ internal_self_insert (int c, EMACS_INT n)
character. In that case, the new point is set after
that character. */
ptrdiff_t actual_clm
= XFASTINT (Fmove_to_column (make_number (target_clm), Qnil));
= XFIXNAT (Fmove_to_column (make_fixnum (target_clm), Qnil));
chars_to_delete = PT - pos;
@ -408,8 +408,8 @@ internal_self_insert (int c, EMACS_INT n)
&& NILP (BVAR (current_buffer, read_only))
&& PT > BEGV
&& (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters))
? XFASTINT (Fprevious_char ())
: UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ())))
? XFIXNAT (Fprevious_char ())
: UNIBYTE_TO_CHAR (XFIXNAT (Fprevious_char ())))
== Sword))
{
EMACS_INT modiff = MODIFF;
@ -439,18 +439,18 @@ internal_self_insert (int c, EMACS_INT n)
int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
&& SINGLE_BYTE_CHAR_P (c))
? UNIBYTE_TO_CHAR (c) : c);
Lisp_Object string = Fmake_string (make_number (n), make_number (mc),
Lisp_Object string = Fmake_string (make_fixnum (n), make_fixnum (mc),
Qnil);
if (spaces_to_insert)
{
tem = Fmake_string (make_number (spaces_to_insert),
make_number (' '), Qnil);
tem = Fmake_string (make_fixnum (spaces_to_insert),
make_fixnum (' '), Qnil);
string = concat2 (string, tem);
}
replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0);
Fforward_char (make_number (n));
Fforward_char (make_fixnum (n));
}
else if (n > 1)
{

418
src/coding.c
View file

File diff suppressed because it is too large Load diff

154
src/composite.c
View file

@ -193,12 +193,12 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
goto invalid_composition;
id = XCAR (prop);
if (INTEGERP (id))
if (FIXNUMP (id))
{
/* PROP should be Form-B. */
if (XINT (id) < 0 || XINT (id) >= n_compositions)
if (XFIXNUM (id) < 0 || XFIXNUM (id) >= n_compositions)
goto invalid_composition;
return XINT (id);
return XFIXNUM (id);
}
/* PROP should be Form-A.
@ -206,7 +206,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
if (!CONSP (id))
goto invalid_composition;
length = XCAR (id);
if (!INTEGERP (length) || XINT (length) != nchars)
if (!FIXNUMP (length) || XFIXNUM (length) != nchars)
goto invalid_composition;
components = XCDR (id);
@ -215,8 +215,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
by consulting composition_hash_table. The key for this table is
COMPONENTS (converted to a vector COMPONENTS-VEC) or, if it is
nil, vector of characters in the composition range. */
if (INTEGERP (components))
key = Fmake_vector (make_number (1), components);
if (FIXNUMP (components))
key = Fmake_vector (make_fixnum (1), components);
else if (STRINGP (components) || CONSP (components))
key = Fvconcat (1, &components);
else if (VECTORP (components))
@ -228,13 +228,13 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
for (i = 0; i < nchars; i++)
{
FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
ASET (key, i, make_number (ch));
ASET (key, i, make_fixnum (ch));
}
else
for (i = 0; i < nchars; i++)
{
FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
ASET (key, i, make_number (ch));
ASET (key, i, make_fixnum (ch));
}
}
else
@ -250,8 +250,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
key = HASH_KEY (hash_table, hash_index);
id = HASH_VALUE (hash_table, hash_index);
XSETCAR (prop, id);
XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
return XINT (id);
XSETCDR (prop, Fcons (make_fixnum (nchars), Fcons (key, XCDR (prop))));
return XFIXNUM (id);
}
/* This composition is a new one. We must register it. */
@ -289,7 +289,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
composition rule). */
for (i = 0; i < len; i++)
{
if (!INTEGERP (key_contents[i]))
if (!FIXNUMP (key_contents[i]))
goto invalid_composition;
}
}
@ -298,14 +298,14 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
the cons cell of PROP because it is not shared. */
XSETFASTINT (id, n_compositions);
XSETCAR (prop, id);
XSETCDR (prop, Fcons (make_number (nchars), Fcons (key, XCDR (prop))));
XSETCDR (prop, Fcons (make_fixnum (nchars), Fcons (key, XCDR (prop))));
/* Register the composition in composition_hash_table. */
hash_index = hash_put (hash_table, key, id, hash_code);
method = (NILP (components)
? COMPOSITION_RELATIVE
: ((INTEGERP (components) || STRINGP (components))
: ((FIXNUMP (components) || STRINGP (components))
? COMPOSITION_WITH_ALTCHARS
: COMPOSITION_WITH_RULE_ALTCHARS));
@ -332,7 +332,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
for (i = 0; i < glyph_len; i++)
{
int this_width;
ch = XINT (key_contents[i]);
ch = XFIXNUM (key_contents[i]);
/* TAB in a composition means display glyphs with padding
space on the left or right. */
this_width = (ch == '\t' ? 1 : CHARACTER_WIDTH (ch));
@ -345,7 +345,7 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
/* Rule-base composition. */
double leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
ch = XFIXNUM (key_contents[0]);
rightmost = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
for (i = 1; i < glyph_len; i += 2)
@ -354,8 +354,8 @@ get_composition_id (ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t nchars,
int this_width;
double this_left;
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
rule = XFIXNUM (key_contents[i]);
ch = XFIXNUM (key_contents[i + 1]);
this_width = ch != '\t' ? CHARACTER_WIDTH (ch) : 1;
/* A composition rule is specified by an integer value
@ -431,9 +431,9 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit,
if (limit > pos) /* search forward */
{
val = Fnext_single_property_change (make_number (pos), Qcomposition,
object, make_number (limit));
pos = XINT (val);
val = Fnext_single_property_change (make_fixnum (pos), Qcomposition,
object, make_fixnum (limit));
pos = XFIXNUM (val);
if (pos == limit)
return 0;
}
@ -442,9 +442,9 @@ find_composition (ptrdiff_t pos, ptrdiff_t limit,
if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
object))
return 1;
val = Fprevious_single_property_change (make_number (pos), Qcomposition,
object, make_number (limit));
pos = XINT (val);
val = Fprevious_single_property_change (make_fixnum (pos), Qcomposition,
object, make_fixnum (limit));
pos = XFIXNUM (val);
if (pos == limit)
return 0;
pos--;
@ -474,7 +474,7 @@ run_composition_function (ptrdiff_t from, ptrdiff_t to, Lisp_Object prop)
&& !composition_valid_p (start, end, prop))
to = end;
if (!NILP (Ffboundp (func)))
call2 (func, make_number (from), make_number (to));
call2 (func, make_fixnum (from), make_fixnum (to));
}
/* Make invalid compositions adjacent to or inside FROM and TO valid.
@ -519,7 +519,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
if (end > to)
max_pos = end;
if (from < end)
Fput_text_property (make_number (from), make_number (end),
Fput_text_property (make_fixnum (from), make_fixnum (end),
Qcomposition,
Fcons (XCAR (prop), XCDR (prop)), Qnil);
run_composition_function (start, end, prop);
@ -560,7 +560,7 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
the former to the copy of it. */
if (to < end)
{
Fput_text_property (make_number (start), make_number (to),
Fput_text_property (make_fixnum (start), make_fixnum (to),
Qcomposition,
Fcons (XCAR (prop), XCDR (prop)), Qnil);
max_pos = end;
@ -582,8 +582,8 @@ update_compositions (ptrdiff_t from, ptrdiff_t to, int check_mask)
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
specbind (Qinhibit_point_motion_hooks, Qt);
Fremove_list_of_text_properties (make_number (min_pos),
make_number (max_pos),
Fremove_list_of_text_properties (make_fixnum (min_pos),
make_fixnum (max_pos),
list1 (Qauto_composed), Qnil);
unbind_to (count, Qnil);
}
@ -625,9 +625,9 @@ compose_text (ptrdiff_t start, ptrdiff_t end, Lisp_Object components,
{
Lisp_Object prop;
prop = Fcons (Fcons (make_number (end - start), components),
prop = Fcons (Fcons (make_fixnum (end - start), components),
modification_func);
Fput_text_property (make_number (start), make_number (end),
Fput_text_property (make_fixnum (start), make_fixnum (end),
Qcomposition, prop, string);
}
@ -669,12 +669,12 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
len = j;
}
copy = Fmake_vector (make_number (len + 2), Qnil);
copy = Fmake_vector (make_fixnum (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
LGSTRING_SET_GLYPH (copy, i, Fcopy_sequence (LGSTRING_GLYPH (gstring, i)));
i = hash_put (h, LGSTRING_HEADER (copy), copy, hash);
LGSTRING_SET_ID (copy, make_number (i));
LGSTRING_SET_ID (copy, make_fixnum (i));
return copy;
}
@ -692,7 +692,7 @@ DEFUN ("clear-composition-cache", Fclear_composition_cache,
Clear composition cache. */)
(void)
{
Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)};
Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)};
gstring_hash_table = CALLMANY (Fmake_hash_table, args);
/* Fixme: We call Fclear_face_cache to force complete re-building of
display glyphs. But, it may be better to call this function from
@ -716,9 +716,9 @@ composition_gstring_p (Lisp_Object gstring)
&& ! CODING_SYSTEM_P (LGSTRING_FONT (gstring))))
return 0;
for (i = 1; i < ASIZE (LGSTRING_HEADER (gstring)); i++)
if (! NATNUMP (AREF (LGSTRING_HEADER (gstring), i)))
if (! FIXNATP (AREF (LGSTRING_HEADER (gstring), i)))
return 0;
if (! NILP (LGSTRING_ID (gstring)) && ! NATNUMP (LGSTRING_ID (gstring)))
if (! NILP (LGSTRING_ID (gstring)) && ! FIXNATP (LGSTRING_ID (gstring)))
return 0;
for (i = 0; i < LGSTRING_GLYPH_LEN (gstring); i++)
{
@ -801,7 +801,7 @@ fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte,
if (VECTORP (header))
{
if (ASIZE (header) != len + 1)
args_out_of_range (header, make_number (len + 1));
args_out_of_range (header, make_fixnum (len + 1));
}
else
{
@ -820,7 +820,7 @@ fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte,
FETCH_CHAR_ADVANCE_NO_CHECK (c, from, from_byte);
else
FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, from, from_byte);
ASET (header, i + 1, make_number (c));
ASET (header, i + 1, make_fixnum (c));
}
return header;
}
@ -836,7 +836,7 @@ fill_gstring_body (Lisp_Object gstring)
for (i = 0; i < len; i++)
{
Lisp_Object g = LGSTRING_GLYPH (gstring, i);
int c = XFASTINT (AREF (header, i + 1));
int c = XFIXNAT (AREF (header, i + 1));
if (NILP (g))
{
@ -852,7 +852,7 @@ fill_gstring_body (Lisp_Object gstring)
}
else
{
int width = XFASTINT (CHAR_TABLE_REF (Vchar_width_table, c));
int width = XFIXNAT (CHAR_TABLE_REF (Vchar_width_table, c));
LGLYPH_SET_CODE (g, c);
LGLYPH_SET_LBEARING (g, 0);
@ -881,7 +881,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
Lisp_Object string)
{
ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object pos = make_number (charpos);
Lisp_Object pos = make_fixnum (charpos);
ptrdiff_t to;
ptrdiff_t pt = PT, pt_byte = PT_BYTE;
Lisp_Object re, font_object, lgstring;
@ -917,7 +917,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
return unbind_to (count, Qnil);
}
#endif
lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object,
lgstring = Fcomposition_get_gstring (pos, make_fixnum (to), font_object,
string);
if (NILP (LGSTRING_ID (lgstring)))
{
@ -926,7 +926,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos,
record_unwind_protect (restore_point_unwind,
build_marker (current_buffer, pt, pt_byte));
lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
pos, make_number (to), font_object, string);
pos, make_fixnum (to), font_object, string);
}
return unbind_to (count, lgstring);
}
@ -941,7 +941,7 @@ char_composable_p (int c)
return (c > ' '
&& (c == ZERO_WIDTH_NON_JOINER || c == ZERO_WIDTH_JOINER
|| (val = CHAR_TABLE_REF (Vunicode_category_table, c),
(INTEGERP (val) && (XINT (val) <= UNICODE_CATEGORY_So)))));
(FIXNUMP (val) && (XFIXNUM (val) <= UNICODE_CATEGORY_So)))));
}
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
@ -1030,11 +1030,11 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
{
Lisp_Object elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3
&& NATNUMP (AREF (elt, 1))
&& charpos - 1 - XFASTINT (AREF (elt, 1)) >= start)
&& FIXNATP (AREF (elt, 1))
&& charpos - 1 - XFIXNAT (AREF (elt, 1)) >= start)
{
cmp_it->rule_idx = ridx;
cmp_it->lookback = XFASTINT (AREF (elt, 1));
cmp_it->lookback = XFIXNAT (AREF (elt, 1));
cmp_it->stop_pos = charpos - 1 - cmp_it->lookback;
cmp_it->ch = c;
return;
@ -1081,10 +1081,10 @@ composition_compute_stop_pos (struct composition_it *cmp_it, ptrdiff_t charpos,
{
Lisp_Object elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3
&& NATNUMP (AREF (elt, 1))
&& charpos - XFASTINT (AREF (elt, 1)) > endpos)
&& FIXNATP (AREF (elt, 1))
&& charpos - XFIXNAT (AREF (elt, 1)) > endpos)
{
ptrdiff_t back = XFASTINT (AREF (elt, 1));
ptrdiff_t back = XFIXNAT (AREF (elt, 1));
ptrdiff_t cpos = charpos - back, bpos;
if (back == 0)
@ -1221,9 +1221,9 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
{
elt = XCAR (val);
if (! VECTORP (elt) || ASIZE (elt) != 3
|| ! INTEGERP (AREF (elt, 1)))
|| ! FIXNUMP (AREF (elt, 1)))
continue;
if (XFASTINT (AREF (elt, 1)) != cmp_it->lookback)
if (XFIXNAT (AREF (elt, 1)) != cmp_it->lookback)
goto no_composition;
lgstring = autocmp_chars (elt, charpos, bytepos, endpos,
w, face, string);
@ -1262,7 +1262,7 @@ composition_reseat_it (struct composition_it *cmp_it, ptrdiff_t charpos,
goto no_composition;
if (NILP (LGSTRING_ID (lgstring)))
lgstring = composition_gstring_put_cache (lgstring, -1);
cmp_it->id = XINT (LGSTRING_ID (lgstring));
cmp_it->id = XFIXNUM (LGSTRING_ID (lgstring));
int i;
for (i = 0; i < LGSTRING_GLYPH_LEN (lgstring); i++)
if (NILP (LGSTRING_GLYPH (lgstring, i)))
@ -1391,7 +1391,7 @@ composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff
cmp_it->width = 0;
for (i = cmp_it->nchars - 1; i >= 0; i--)
{
c = XINT (LGSTRING_CHAR (gstring, from + i));
c = XFIXNUM (LGSTRING_CHAR (gstring, from + i));
cmp_it->nbytes += CHAR_BYTES (c);
cmp_it->width += CHARACTER_WIDTH (c);
}
@ -1559,9 +1559,9 @@ find_automatic_composition (ptrdiff_t pos, ptrdiff_t limit,
{
Lisp_Object elt = XCAR (val);
if (VECTORP (elt) && ASIZE (elt) == 3 && NATNUMP (AREF (elt, 1)))
if (VECTORP (elt) && ASIZE (elt) == 3 && FIXNATP (AREF (elt, 1)))
{
EMACS_INT check_pos = cur.pos - XFASTINT (AREF (elt, 1));
EMACS_INT check_pos = cur.pos - XFIXNAT (AREF (elt, 1));
struct position_record check;
if (check_pos < head
@ -1739,8 +1739,8 @@ should be ignored. */)
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
error ("Attempt to shape unibyte text");
validate_region (&from, &to);
frompos = XFASTINT (from);
topos = XFASTINT (to);
frompos = XFIXNAT (from);
topos = XFIXNAT (to);
frombyte = CHAR_TO_BYTE (frompos);
}
else
@ -1759,7 +1759,7 @@ should be ignored. */)
return gstring;
if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
gstring_work = Fmake_vector (make_fixnum (topos - frompos + 2), Qnil);
LGSTRING_SET_HEADER (gstring_work, header);
LGSTRING_SET_ID (gstring_work, Qnil);
fill_gstring_body (gstring_work);
@ -1780,12 +1780,12 @@ for the composition. See `compose-region' for more details. */)
{
validate_region (&start, &end);
if (!NILP (components)
&& !INTEGERP (components)
&& !FIXNUMP (components)
&& !CONSP (components)
&& !STRINGP (components))
CHECK_VECTOR (components);
compose_text (XINT (start), XINT (end), components, modification_func, Qnil);
compose_text (XFIXNUM (start), XFIXNUM (end), components, modification_func, Qnil);
return Qnil;
}
@ -1820,11 +1820,11 @@ See `find-composition' for more details. */)
ptrdiff_t start, end, from, to;
int id;
CHECK_NUMBER_COERCE_MARKER (pos);
CHECK_FIXNUM_COERCE_MARKER (pos);
if (!NILP (limit))
{
CHECK_NUMBER_COERCE_MARKER (limit);
to = min (XINT (limit), ZV);
CHECK_FIXNUM_COERCE_MARKER (limit);
to = min (XFIXNUM (limit), ZV);
}
else
to = -1;
@ -1832,15 +1832,15 @@ See `find-composition' for more details. */)
if (!NILP (string))
{
CHECK_STRING (string);
if (XINT (pos) < 0 || XINT (pos) > SCHARS (string))
if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string))
args_out_of_range (string, pos);
}
else
{
if (XINT (pos) < BEGV || XINT (pos) > ZV)
if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV)
args_out_of_range (Fcurrent_buffer (), pos);
}
from = XINT (pos);
from = XFIXNUM (pos);
if (!find_composition (from, to, &start, &end, &prop, string))
{
@ -1848,21 +1848,21 @@ See `find-composition' for more details. */)
&& ! NILP (Vauto_composition_mode)
&& find_automatic_composition (from, to, &start, &end, &gstring,
string))
return list3 (make_number (start), make_number (end), gstring);
return list3 (make_fixnum (start), make_fixnum (end), gstring);
return Qnil;
}
if ((end <= XINT (pos) || start > XINT (pos)))
if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos)))
{
ptrdiff_t s, e;
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
&& (e <= XINT (pos) ? e > end : s < start))
return list3 (make_number (s), make_number (e), gstring);
&& (e <= XFIXNUM (pos) ? e > end : s < start))
return list3 (make_fixnum (s), make_fixnum (e), gstring);
}
if (!composition_valid_p (start, end, prop))
return list3 (make_number (start), make_number (end), Qnil);
return list3 (make_fixnum (start), make_fixnum (end), Qnil);
if (NILP (detail_p))
return list3 (make_number (start), make_number (end), Qt);
return list3 (make_fixnum (start), make_fixnum (end), Qt);
if (composition_registered_p (prop))
id = COMPOSITION_ID (prop);
@ -1884,12 +1884,12 @@ See `find-composition' for more details. */)
relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
? Qnil : Qt);
mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
tail = list4 (components, relative_p, mod_func, make_number (width));
tail = list4 (components, relative_p, mod_func, make_fixnum (width));
}
else
tail = Qnil;
return Fcons (make_number (start), Fcons (make_number (end), tail));
return Fcons (make_fixnum (start), Fcons (make_fixnum (end), tail));
}
@ -1906,7 +1906,7 @@ syms_of_composite (void)
created compositions are repeatedly used in an Emacs session,
and thus it's not worth to save memory in such a way. So, we
make the table not weak. */
Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)};
Lisp_Object args[] = {QCtest, Qequal, QCsize, make_fixnum (311)};
composition_hash_table = CALLMANY (Fmake_hash_table, args);
staticpro (&composition_hash_table);
@ -1917,9 +1917,9 @@ syms_of_composite (void)
staticpro (&gstring_work_headers);
gstring_work_headers = make_uninit_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
ASET (gstring_work_headers, i, Fmake_vector (make_fixnum (i + 2), Qnil));
staticpro (&gstring_work);
gstring_work = Fmake_vector (make_number (10), Qnil);
gstring_work = Fmake_vector (make_fixnum (10), Qnil);
/* Text property `composition' should be nonsticky by default. */
Vtext_property_default_nonsticky

56
src/composite.h
View file

@ -59,17 +59,17 @@ enum composition_method {
INLINE bool
composition_registered_p (Lisp_Object prop)
{
return INTEGERP (XCAR (prop));
return FIXNUMP (XCAR (prop));
}
/* Return ID number of the already registered composition. */
#define COMPOSITION_ID(prop) XINT (XCAR (prop))
#define COMPOSITION_ID(prop) XFIXNUM (XCAR (prop))
/* Return length of the composition. */
#define COMPOSITION_LENGTH(prop) \
(composition_registered_p (prop) \
? XINT (XCAR (XCDR (prop))) \
: XINT (XCAR (XCAR (prop))))
? XFIXNUM (XCAR (XCDR (prop))) \
: XFIXNUM (XCAR (XCAR (prop))))
/* Return components of the composition. */
#define COMPOSITION_COMPONENTS(prop) \
@ -86,7 +86,7 @@ composition_registered_p (Lisp_Object prop)
/* Return the Nth glyph of composition specified by CMP. CMP is a
pointer to `struct composition'. */
#define COMPOSITION_GLYPH(cmp, n) \
XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
->key_and_value) \
->contents[cmp->hash_index * 2]) \
->contents[cmp->method == COMPOSITION_WITH_RULE_ALTCHARS \
@ -96,7 +96,7 @@ composition_registered_p (Lisp_Object prop)
rule-base composition specified by CMP. CMP is a pointer to
`struct composition'. */
#define COMPOSITION_RULE(cmp, n) \
XINT (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
XFIXNUM (XVECTOR (XVECTOR (XHASH_TABLE (composition_hash_table) \
->key_and_value) \
->contents[cmp->hash_index * 2]) \
->contents[(n) * 2 - 1])
@ -213,7 +213,7 @@ composition_method (Lisp_Object prop)
Lisp_Object temp = XCDR (XCAR (prop));
return (NILP (temp)
? COMPOSITION_RELATIVE
: INTEGERP (temp) || STRINGP (temp)
: FIXNUMP (temp) || STRINGP (temp)
? COMPOSITION_WITH_ALTCHARS
: COMPOSITION_WITH_RULE_ALTCHARS);
}
@ -234,7 +234,7 @@ composition_valid_p (ptrdiff_t start, ptrdiff_t end, Lisp_Object prop)
&& (NILP (XCDR (XCAR (prop)))
|| STRINGP (XCDR (XCAR (prop)))
|| VECTORP (XCDR (XCAR (prop)))
|| INTEGERP (XCDR (XCAR (prop)))
|| FIXNUMP (XCDR (XCAR (prop)))
|| CONSP (XCDR (XCAR (prop))))))
&& COMPOSITION_LENGTH (prop) == end - start);
}
@ -274,41 +274,41 @@ enum lglyph_indices
LGLYPH_SIZE
};
#define LGLYPH_NEW() Fmake_vector (make_number (LGLYPH_SIZE), Qnil)
#define LGLYPH_FROM(g) XINT (AREF ((g), LGLYPH_IX_FROM))
#define LGLYPH_TO(g) XINT (AREF ((g), LGLYPH_IX_TO))
#define LGLYPH_CHAR(g) XINT (AREF ((g), LGLYPH_IX_CHAR))
#define LGLYPH_NEW() Fmake_vector (make_fixnum (LGLYPH_SIZE), Qnil)
#define LGLYPH_FROM(g) XFIXNUM (AREF ((g), LGLYPH_IX_FROM))
#define LGLYPH_TO(g) XFIXNUM (AREF ((g), LGLYPH_IX_TO))
#define LGLYPH_CHAR(g) XFIXNUM (AREF ((g), LGLYPH_IX_CHAR))
#define LGLYPH_CODE(g) \
(NILP (AREF ((g), LGLYPH_IX_CODE)) \
? FONT_INVALID_CODE \
: cons_to_unsigned (AREF (g, LGLYPH_IX_CODE), TYPE_MAXIMUM (unsigned)))
#define LGLYPH_WIDTH(g) XINT (AREF ((g), LGLYPH_IX_WIDTH))
#define LGLYPH_LBEARING(g) XINT (AREF ((g), LGLYPH_IX_LBEARING))
#define LGLYPH_RBEARING(g) XINT (AREF ((g), LGLYPH_IX_RBEARING))
#define LGLYPH_ASCENT(g) XINT (AREF ((g), LGLYPH_IX_ASCENT))
#define LGLYPH_DESCENT(g) XINT (AREF ((g), LGLYPH_IX_DESCENT))
#define LGLYPH_WIDTH(g) XFIXNUM (AREF ((g), LGLYPH_IX_WIDTH))
#define LGLYPH_LBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_LBEARING))
#define LGLYPH_RBEARING(g) XFIXNUM (AREF ((g), LGLYPH_IX_RBEARING))
#define LGLYPH_ASCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_ASCENT))
#define LGLYPH_DESCENT(g) XFIXNUM (AREF ((g), LGLYPH_IX_DESCENT))
#define LGLYPH_ADJUSTMENT(g) AREF ((g), LGLYPH_IX_ADJUSTMENT)
#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_number (val))
#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_number (val))
#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_number (val))
#define LGLYPH_SET_FROM(g, val) ASET ((g), LGLYPH_IX_FROM, make_fixnum (val))
#define LGLYPH_SET_TO(g, val) ASET ((g), LGLYPH_IX_TO, make_fixnum (val))
#define LGLYPH_SET_CHAR(g, val) ASET ((g), LGLYPH_IX_CHAR, make_fixnum (val))
/* Callers must assure that VAL is not negative! */
#define LGLYPH_SET_CODE(g, val) \
ASET (g, LGLYPH_IX_CODE, \
val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val))
#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_number (val))
#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_number (val))
#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_number (val))
#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_number (val))
#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_number (val))
#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val))
#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum (val))
#define LGLYPH_SET_RBEARING(g, val) ASET ((g), LGLYPH_IX_RBEARING, make_fixnum (val))
#define LGLYPH_SET_ASCENT(g, val) ASET ((g), LGLYPH_IX_ASCENT, make_fixnum (val))
#define LGLYPH_SET_DESCENT(g, val) ASET ((g), LGLYPH_IX_DESCENT, make_fixnum (val))
#define LGLYPH_SET_ADJUSTMENT(g, val) ASET ((g), LGLYPH_IX_ADJUSTMENT, (val))
#define LGLYPH_XOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \
? XINT (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0)
? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 0)) : 0)
#define LGLYPH_YOFF(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \
? XINT (AREF (LGLYPH_ADJUSTMENT (g), 1)) : 0)
? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 1)) : 0)
#define LGLYPH_WADJUST(g) (VECTORP (LGLYPH_ADJUSTMENT (g)) \
? XINT (AREF (LGLYPH_ADJUSTMENT (g), 2)) : 0)
? XFIXNUM (AREF (LGLYPH_ADJUSTMENT (g), 2)) : 0)
extern Lisp_Object composition_gstring_put_cache (Lisp_Object, ptrdiff_t);
extern Lisp_Object composition_gstring_from_id (ptrdiff_t);

18
src/conf_post.h
View file

@ -20,9 +20,16 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Put the code here rather than in configure.ac using AH_BOTTOM.
This way, the code does not get processed by autoheader. For
example, undefs here are not commented out.
example, undefs here are not commented out. */
To help make dependencies clearer elsewhere, this file typically
/* Disable 'assert' unless enabling checking. Do this early, in
case some misguided implementation depends on NDEBUG in some
include file other than assert.h. */
#if !defined ENABLE_CHECKING && !defined NDEBUG
# define NDEBUG
#endif
/* To help make dependencies clearer elsewhere, this file typically
does not #include other files. The exceptions are first stdbool.h
because it is unlikely to interfere with configuration and bool is
such a core part of the C language, and second ms-w32.h (DOS_NT
@ -202,6 +209,13 @@ extern void _DebPrint (const char *fmt, ...);
#endif
#endif
#ifdef emacs /* Don't do this for lib-src. */
/* Tell regex.c to use a type compatible with Emacs. */
#define RE_TRANSLATE_TYPE Lisp_Object
#define RE_TRANSLATE(TBL, C) char_table_translate (TBL, C)
#define RE_TRANSLATE_P(TBL) (!EQ (TBL, make_fixnum (0)))
#endif
/* Tell time_rz.c to use Emacs's getter and setter for TZ.
Only Emacs uses time_rz so this is OK. */
#define getenv_TZ emacs_getenv_TZ

762
src/data.c
View file

File diff suppressed because it is too large Load diff

74
src/dbusbind.c
View file

@ -201,8 +201,8 @@ xd_symbol_to_dbus_type (Lisp_Object object)
arguments to a D-Bus message. */
#define XD_OBJECT_TO_DBUS_TYPE(object) \
((EQ (object, Qt) || NILP (object)) ? DBUS_TYPE_BOOLEAN \
: (NATNUMP (object)) ? DBUS_TYPE_UINT32 \
: (INTEGERP (object)) ? DBUS_TYPE_INT32 \
: (FIXNATP (object)) ? DBUS_TYPE_UINT32 \
: (FIXNUMP (object)) ? DBUS_TYPE_INT32 \
: (FLOATP (object)) ? DBUS_TYPE_DOUBLE \
: (STRINGP (object)) ? DBUS_TYPE_STRING \
: (XD_DBUS_TYPE_P (object)) ? xd_symbol_to_dbus_type (object) \
@ -355,7 +355,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
{
case DBUS_TYPE_BYTE:
case DBUS_TYPE_UINT16:
CHECK_NATNUM (object);
CHECK_FIXNAT (object);
sprintf (signature, "%c", dtype);
break;
@ -366,7 +366,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
break;
case DBUS_TYPE_INT16:
CHECK_NUMBER (object);
CHECK_FIXNUM (object);
sprintf (signature, "%c", dtype);
break;
@ -378,7 +378,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
case DBUS_TYPE_INT32:
case DBUS_TYPE_INT64:
case DBUS_TYPE_DOUBLE:
CHECK_NUMBER_OR_FLOAT (object);
CHECK_FIXNUM_OR_FLOAT (object);
sprintf (signature, "%c", dtype);
break;
@ -519,11 +519,11 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object)
static intmax_t
xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
{
CHECK_NUMBER_OR_FLOAT (x);
if (INTEGERP (x))
CHECK_FIXNUM_OR_FLOAT (x);
if (FIXNUMP (x))
{
if (lo <= XINT (x) && XINT (x) <= hi)
return XINT (x);
if (lo <= XFIXNUM (x) && XFIXNUM (x) <= hi)
return XFIXNUM (x);
}
else
{
@ -547,11 +547,11 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
static uintmax_t
xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
{
CHECK_NUMBER_OR_FLOAT (x);
if (INTEGERP (x))
CHECK_FIXNUM_OR_FLOAT (x);
if (FIXNUMP (x))
{
if (0 <= XINT (x) && XINT (x) <= hi)
return XINT (x);
if (0 <= XFIXNUM (x) && XFIXNUM (x) <= hi)
return XFIXNUM (x);
}
else
{
@ -566,7 +566,7 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
if (xd_in_read_queued_messages)
Fthrow (Qdbus_error, Qnil);
else
args_out_of_range_3 (x, make_number (0), make_fixnum_or_float (hi));
args_out_of_range_3 (x, make_fixnum (0), make_fixnum_or_float (hi));
}
/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
@ -584,9 +584,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
switch (dtype)
{
case DBUS_TYPE_BYTE:
CHECK_NATNUM (object);
CHECK_FIXNAT (object);
{
unsigned char val = XFASTINT (object) & 0xFF;
unsigned char val = XFIXNAT (object) & 0xFF;
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
if (!dbus_message_iter_append_basic (iter, dtype, &val))
XD_SIGNAL2 (build_string ("Unable to append argument"), object);
@ -750,7 +750,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
make_number (dtype), build_string (signature));
make_fixnum (dtype), build_string (signature));
break;
case DBUS_TYPE_VARIANT:
@ -763,7 +763,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
if (!dbus_message_iter_open_container (iter, dtype,
signature, &subiter))
XD_SIGNAL3 (build_string ("Cannot open container"),
make_number (dtype), build_string (signature));
make_fixnum (dtype), build_string (signature));
break;
case DBUS_TYPE_STRUCT:
@ -772,7 +772,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
XD_DEBUG_MESSAGE ("%c %s", dtype, XD_OBJECT_TO_STRING (object));
if (!dbus_message_iter_open_container (iter, dtype, NULL, &subiter))
XD_SIGNAL2 (build_string ("Cannot open container"),
make_number (dtype));
make_fixnum (dtype));
break;
}
@ -790,7 +790,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter)
/* Close the subiteration. */
if (!dbus_message_iter_close_container (iter, &subiter))
XD_SIGNAL2 (build_string ("Cannot close container"),
make_number (dtype));
make_fixnum (dtype));
}
}
@ -810,7 +810,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
val = val & 0xFF;
XD_DEBUG_MESSAGE ("%c %u", dtype, val);
return make_number (val);
return make_fixnum (val);
}
case DBUS_TYPE_BOOLEAN:
@ -828,7 +828,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
return make_fixnum (val);
}
case DBUS_TYPE_UINT16:
@ -838,7 +838,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
return make_number (val);
return make_fixnum (val);
}
case DBUS_TYPE_INT32:
@ -1200,7 +1200,7 @@ this connection to those buses. */)
refcount = xd_get_connection_references (connection);
XD_DEBUG_MESSAGE ("Bus %s, Reference counter %"pD"d",
XD_OBJECT_TO_STRING (bus), refcount);
return make_number (refcount);
return make_fixnum (refcount);
}
DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name,
@ -1275,11 +1275,11 @@ usage: (dbus-message-internal &rest REST) */)
service = args[2];
handler = Qnil;
CHECK_NATNUM (message_type);
if (! (DBUS_MESSAGE_TYPE_INVALID < XFASTINT (message_type)
&& XFASTINT (message_type) < DBUS_NUM_MESSAGE_TYPES))
CHECK_FIXNAT (message_type);
if (! (DBUS_MESSAGE_TYPE_INVALID < XFIXNAT (message_type)
&& XFIXNAT (message_type) < DBUS_NUM_MESSAGE_TYPES))
XD_SIGNAL2 (build_string ("Invalid message type"), message_type);
mtype = XFASTINT (message_type);
mtype = XFIXNAT (message_type);
if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
|| (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
@ -1303,7 +1303,7 @@ usage: (dbus-message-internal &rest REST) */)
if (nargs < count)
xsignal2 (Qwrong_number_of_arguments,
Qdbus_message_internal,
make_number (nargs));
make_fixnum (nargs));
if ((mtype == DBUS_MESSAGE_TYPE_METHOD_CALL)
|| (mtype == DBUS_MESSAGE_TYPE_SIGNAL))
@ -1409,8 +1409,8 @@ usage: (dbus-message-internal &rest REST) */)
/* Check for timeout parameter. */
if ((count + 2 <= nargs) && EQ (args[count], QCtimeout))
{
CHECK_NATNUM (args[count+1]);
timeout = min (XFASTINT (args[count+1]), INT_MAX);
CHECK_FIXNAT (args[count+1]);
timeout = min (XFIXNAT (args[count+1]), INT_MAX);
count = count+2;
}
@ -1609,7 +1609,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus)
event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
event.arg);
event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
event.arg = Fcons (make_number (mtype), event.arg);
event.arg = Fcons (make_fixnum (mtype), event.arg);
/* Add the bus symbol to the event. */
event.arg = Fcons (bus, event.arg);
@ -1754,28 +1754,28 @@ syms_of_dbusbind (void)
DEFVAR_LISP ("dbus-message-type-invalid",
Vdbus_message_type_invalid,
doc: /* This value is never a valid message type. */);
Vdbus_message_type_invalid = make_number (DBUS_MESSAGE_TYPE_INVALID);
Vdbus_message_type_invalid = make_fixnum (DBUS_MESSAGE_TYPE_INVALID);
DEFVAR_LISP ("dbus-message-type-method-call",
Vdbus_message_type_method_call,
doc: /* Message type of a method call message. */);
Vdbus_message_type_method_call = make_number (DBUS_MESSAGE_TYPE_METHOD_CALL);
Vdbus_message_type_method_call = make_fixnum (DBUS_MESSAGE_TYPE_METHOD_CALL);
DEFVAR_LISP ("dbus-message-type-method-return",
Vdbus_message_type_method_return,
doc: /* Message type of a method return message. */);
Vdbus_message_type_method_return
= make_number (DBUS_MESSAGE_TYPE_METHOD_RETURN);
= make_fixnum (DBUS_MESSAGE_TYPE_METHOD_RETURN);
DEFVAR_LISP ("dbus-message-type-error",
Vdbus_message_type_error,
doc: /* Message type of an error reply message. */);
Vdbus_message_type_error = make_number (DBUS_MESSAGE_TYPE_ERROR);
Vdbus_message_type_error = make_fixnum (DBUS_MESSAGE_TYPE_ERROR);
DEFVAR_LISP ("dbus-message-type-signal",
Vdbus_message_type_signal,
doc: /* Message type of a signal message. */);
Vdbus_message_type_signal = make_number (DBUS_MESSAGE_TYPE_SIGNAL);
Vdbus_message_type_signal = make_fixnum (DBUS_MESSAGE_TYPE_SIGNAL);
DEFVAR_LISP ("dbus-registered-objects-table",
Vdbus_registered_objects_table,

4
src/decompress.c
View file

@ -149,8 +149,8 @@ This function can be called only in unibyte buffers. */)
/* This is a unibyte buffer, so character positions and bytes are
the same. */
istart = XINT (start);
iend = XINT (end);
istart = XFIXNUM (start);
iend = XFIXNUM (end);
/* Do the following before manipulating the gap. */
modify_text (istart, iend);

22
src/dired.c
View file

@ -671,15 +671,15 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
/* Reject entries where the encoded strings match, but the
decoded don't. For example, "a" should not match "a-ring" on
file systems that store decomposed characters. */
Lisp_Object zero = make_number (0);
Lisp_Object zero = make_fixnum (0);
if (check_decoded && SCHARS (file) <= SCHARS (name))
{
/* FIXME: This is a copy of the code below. */
ptrdiff_t compare = SCHARS (file);
Lisp_Object cmp
= Fcompare_strings (name, zero, make_number (compare),
file, zero, make_number (compare),
= Fcompare_strings (name, zero, make_fixnum (compare),
file, zero, make_fixnum (compare),
completion_ignore_case ? Qt : Qnil);
if (!EQ (cmp, Qt))
continue;
@ -701,10 +701,10 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
/* FIXME: This is a copy of the code in Ftry_completion. */
ptrdiff_t compare = min (bestmatchsize, SCHARS (name));
Lisp_Object cmp
= Fcompare_strings (bestmatch, zero, make_number (compare),
name, zero, make_number (compare),
= Fcompare_strings (bestmatch, zero, make_fixnum (compare),
name, zero, make_fixnum (compare),
completion_ignore_case ? Qt : Qnil);
ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XINT (cmp)) - 1;
ptrdiff_t matchsize = EQ (cmp, Qt) ? compare : eabs (XFIXNUM (cmp)) - 1;
if (completion_ignore_case)
{
@ -729,13 +729,13 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
==
(matchsize + directoryp == SCHARS (bestmatch)))
&& (cmp = Fcompare_strings (name, zero,
make_number (SCHARS (file)),
make_fixnum (SCHARS (file)),
file, zero,
Qnil,
Qnil),
EQ (Qt, cmp))
&& (cmp = Fcompare_strings (bestmatch, zero,
make_number (SCHARS (file)),
make_fixnum (SCHARS (file)),
file, zero,
Qnil,
Qnil),
@ -769,8 +769,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
it does not require any change to be made. */
if (matchcount == 1 && !NILP (Fequal (bestmatch, file)))
return Qt;
bestmatch = Fsubstring (bestmatch, make_number (0),
make_number (bestmatchsize));
bestmatch = Fsubstring (bestmatch, make_fixnum (0),
make_fixnum (bestmatchsize));
return bestmatch;
}
@ -1009,7 +1009,7 @@ file_attributes (int fd, char const *name,
return CALLN (Flist,
file_type,
make_number (s.st_nlink),
make_fixnum (s.st_nlink),
(uname
? DECODE_SYSTEM (build_unibyte_string (uname))
: make_fixnum_or_float (s.st_uid)),

18
src/dispextern.h
View file

@ -306,24 +306,24 @@ INLINE int
GLYPH_CODE_CHAR (Lisp_Object gc)
{
return (CONSP (gc)
? XINT (XCAR (gc))
: XINT (gc) & MAX_CHAR);
? XFIXNUM (XCAR (gc))
: XFIXNUM (gc) & MAX_CHAR);
}
INLINE int
GLYPH_CODE_FACE (Lisp_Object gc)
{
return CONSP (gc) ? XINT (XCDR (gc)) : XINT (gc) >> CHARACTERBITS;
return CONSP (gc) ? XFIXNUM (XCDR (gc)) : XFIXNUM (gc) >> CHARACTERBITS;
}
#define SET_GLYPH_FROM_GLYPH_CODE(glyph, gc) \
do \
{ \
if (CONSP (gc)) \
SET_GLYPH (glyph, XINT (XCAR (gc)), XINT (XCDR (gc))); \
SET_GLYPH (glyph, XFIXNUM (XCAR (gc)), XFIXNUM (XCDR (gc))); \
else \
SET_GLYPH (glyph, (XINT (gc) & ((1 << CHARACTERBITS)-1)), \
(XINT (gc) >> CHARACTERBITS)); \
SET_GLYPH (glyph, (XFIXNUM (gc) & ((1 << CHARACTERBITS)-1)), \
(XFIXNUM (gc) >> CHARACTERBITS)); \
} \
while (false)
@ -1837,8 +1837,8 @@ GLYPH_CODE_P (Lisp_Object gc)
{
return (CONSP (gc)
? (CHARACTERP (XCAR (gc))
&& RANGED_INTEGERP (0, XCDR (gc), MAX_FACE_ID))
: (RANGED_INTEGERP
&& RANGED_FIXNUMP (0, XCDR (gc), MAX_FACE_ID))
: (RANGED_FIXNUMP
(0, gc,
(MAX_FACE_ID < TYPE_MAXIMUM (EMACS_INT) >> CHARACTERBITS
? ((EMACS_INT) MAX_FACE_ID << CHARACTERBITS) | MAX_CHAR
@ -2482,7 +2482,7 @@ struct it
If `what' is anything else, these two are undefined (will
probably hold values for the last IT_CHARACTER or IT_COMPOSITION
traversed by the iterator.
traversed by the iterator).
The values are updated by get_next_display_element, so they are
out of sync with the value returned by IT_CHARPOS between the

18
src/dispnew.c
View file

@ -5717,8 +5717,8 @@ additional wait period, in milliseconds; this is for backwards compatibility.
if (!NILP (milliseconds))
{
CHECK_NUMBER (milliseconds);
duration += XINT (milliseconds) / 1000.0;
CHECK_FIXNUM (milliseconds);
duration += XFIXNUM (milliseconds) / 1000.0;
}
if (duration > 0)
@ -5766,9 +5766,9 @@ sit_for (Lisp_Object timeout, bool reading, int display_option)
if (display_option > 1)
redisplay_preserve_echo_area (2);
if (INTEGERP (timeout))
if (FIXNUMP (timeout))
{
sec = XINT (timeout);
sec = XFIXNUM (timeout);
if (sec <= 0)
return Qt;
nsec = 0;
@ -5925,7 +5925,7 @@ pass nil for VARIABLE. */)
|| n + 20 < ASIZE (state) / 2)
/* Add 20 extra so we grow it less often. */
{
state = Fmake_vector (make_number (n + 20), Qlambda);
state = Fmake_vector (make_fixnum (n + 20), Qlambda);
if (! NILP (variable))
Fset (variable, state);
else
@ -6041,7 +6041,7 @@ init_display (void)
{
Vinitial_window_system = Qx;
#ifdef HAVE_X11
Vwindow_system_version = make_number (11);
Vwindow_system_version = make_fixnum (11);
#endif
#ifdef USE_NCURSES
/* In some versions of ncurses,
@ -6057,7 +6057,7 @@ init_display (void)
if (!inhibit_window_system)
{
Vinitial_window_system = Qw32;
Vwindow_system_version = make_number (1);
Vwindow_system_version = make_fixnum (1);
return;
}
#endif /* HAVE_NTGUI */
@ -6070,7 +6070,7 @@ init_display (void)
)
{
Vinitial_window_system = Qns;
Vwindow_system_version = make_number (10);
Vwindow_system_version = make_fixnum (10);
return;
}
#endif
@ -6223,7 +6223,7 @@ syms_of_display (void)
defsubr (&Sdump_redisplay_history);
#endif
frame_and_buffer_state = Fmake_vector (make_number (20), Qlambda);
frame_and_buffer_state = Fmake_vector (make_fixnum (20), Qlambda);
staticpro (&frame_and_buffer_state);
/* This is the "purpose" slot of a display table. */

4
src/disptab.h
View file

@ -72,14 +72,14 @@ extern struct Lisp_Char_Table *buffer_display_table (void);
/* Given BASE and LEN returned by the two previous macros,
return nonzero if GLYPH code G is aliased to a different code. */
#define GLYPH_ALIAS_P(base,len,g) \
(GLYPH_FACE (g) == DEFAULT_FACE_ID && GLYPH_CHAR (g) < (len) && INTEGERP (base[GLYPH_CHAR (g)]))
(GLYPH_FACE (g) == DEFAULT_FACE_ID && GLYPH_CHAR (g) < (len) && FIXNUMP (base[GLYPH_CHAR (g)]))
/* Follow all aliases for G in the glyph table given by (BASE,
LENGTH), and set G to the final glyph. */
#define GLYPH_FOLLOW_ALIASES(base, length, g) \
do { \
while (GLYPH_ALIAS_P ((base), (length), (g))) \
SET_GLYPH_CHAR ((g), XINT ((base)[GLYPH_CHAR (g)])); \
SET_GLYPH_CHAR ((g), XFIXNUM ((base)[GLYPH_CHAR (g)])); \
if (!GLYPH_CHAR_VALID_P (g)) \
SET_GLYPH_CHAR (g, ' '); \
} while (false)

28
src/doc.c
View file

@ -89,7 +89,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
ptrdiff_t count = SPECPDL_INDEX ();
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
if (FIXNUMP (filepos))
{
file = Vdoc_file_name;
pos = filepos;
@ -102,7 +102,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
else
return Qnil;
position = eabs (XINT (pos));
position = eabs (XFIXNUM (pos));
if (!STRINGP (Vdoc_directory))
return Qnil;
@ -339,7 +339,7 @@ string is passed through `substitute-command-keys'. */)
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
if (SUBRP (fun))
doc = make_number (XSUBR (fun)->doc);
doc = make_fixnum (XSUBR (fun)->doc);
else if (MODULE_FUNCTIONP (fun))
doc = XMODULE_FUNCTION (fun)->documentation;
else if (COMPILEDP (fun))
@ -351,7 +351,7 @@ string is passed through `substitute-command-keys'. */)
Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
if (STRINGP (tem))
doc = tem;
else if (NATNUMP (tem) || CONSP (tem))
else if (FIXNATP (tem) || CONSP (tem))
doc = tem;
else
return Qnil;
@ -378,7 +378,7 @@ string is passed through `substitute-command-keys'. */)
doc = tem;
/* Handle a doc reference--but these never come last
in the function body, so reject them if they are last. */
else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
&& !NILP (XCDR (tem1)))
doc = tem;
else
@ -395,9 +395,9 @@ string is passed through `substitute-command-keys'. */)
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
if (EQ (doc, make_number (0)))
if (EQ (doc, make_fixnum (0)))
doc = Qnil;
if (INTEGERP (doc) || CONSP (doc))
if (FIXNUMP (doc) || CONSP (doc))
{
Lisp_Object tem;
tem = get_doc_string (doc, 0, 0);
@ -437,9 +437,9 @@ aren't strings. */)
documentation_property:
tem = Fget (symbol, prop);
if (EQ (tem, make_number (0)))
if (EQ (tem, make_fixnum (0)))
tem = Qnil;
if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
if (FIXNUMP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
{
Lisp_Object doc = tem;
tem = get_doc_string (tem, 0, 0);
@ -486,10 +486,10 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
if (CONSP (tem) && FIXNUMP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
XSETCAR (tem, make_fixnum (offset));
}
}
@ -503,7 +503,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if (PVSIZE (fun) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
@ -635,7 +635,7 @@ the same file name is found in the `doc-directory'. */)
|| !NILP (Fmemq (sym, delayed_init)))
&& strncmp (end, "\nSKIP", 5))
Fput (sym, Qvariable_documentation,
make_number ((pos + end + 1 - buf)
make_fixnum ((pos + end + 1 - buf)
* (end[1] == '*' ? -1 : 1)));
}
@ -671,7 +671,7 @@ default_to_grave_quoting_style (void)
Lisp_Object dv = DISP_CHAR_VECTOR (XCHAR_TABLE (Vstandard_display_table),
LEFT_SINGLE_QUOTATION_MARK);
return (VECTORP (dv) && ASIZE (dv) == 1
&& EQ (AREF (dv, 0), make_number ('`')));
&& EQ (AREF (dv, 0), make_fixnum ('`')));
}
/* Return the current effective text quoting style. */

68
src/dosfns.c
View file

@ -66,33 +66,33 @@ REGISTERS should be a vector produced by `make-register' and
int no;
union REGS inregs, outregs;
CHECK_NUMBER (interrupt);
no = (unsigned long) XINT (interrupt);
CHECK_FIXNUM (interrupt);
no = (unsigned long) XFIXNUM (interrupt);
CHECK_VECTOR (registers);
if (no < 0 || no > 0xff || ASIZE (registers) != 8)
return Qnil;
for (i = 0; i < 8; i++)
CHECK_NUMBER (AREF (registers, i));
CHECK_FIXNUM (AREF (registers, i));
inregs.x.ax = (unsigned long) XFASTINT (AREF (registers, 0));
inregs.x.bx = (unsigned long) XFASTINT (AREF (registers, 1));
inregs.x.cx = (unsigned long) XFASTINT (AREF (registers, 2));
inregs.x.dx = (unsigned long) XFASTINT (AREF (registers, 3));
inregs.x.si = (unsigned long) XFASTINT (AREF (registers, 4));
inregs.x.di = (unsigned long) XFASTINT (AREF (registers, 5));
inregs.x.cflag = (unsigned long) XFASTINT (AREF (registers, 6));
inregs.x.flags = (unsigned long) XFASTINT (AREF (registers, 7));
inregs.x.ax = (unsigned long) XFIXNAT (AREF (registers, 0));
inregs.x.bx = (unsigned long) XFIXNAT (AREF (registers, 1));
inregs.x.cx = (unsigned long) XFIXNAT (AREF (registers, 2));
inregs.x.dx = (unsigned long) XFIXNAT (AREF (registers, 3));
inregs.x.si = (unsigned long) XFIXNAT (AREF (registers, 4));
inregs.x.di = (unsigned long) XFIXNAT (AREF (registers, 5));
inregs.x.cflag = (unsigned long) XFIXNAT (AREF (registers, 6));
inregs.x.flags = (unsigned long) XFIXNAT (AREF (registers, 7));
int86 (no, &inregs, &outregs);
ASET (registers, 0, make_number (outregs.x.ax));
ASET (registers, 1, make_number (outregs.x.bx));
ASET (registers, 2, make_number (outregs.x.cx));
ASET (registers, 3, make_number (outregs.x.dx));
ASET (registers, 4, make_number (outregs.x.si));
ASET (registers, 5, make_number (outregs.x.di));
ASET (registers, 6, make_number (outregs.x.cflag));
ASET (registers, 7, make_number (outregs.x.flags));
ASET (registers, 0, make_fixnum (outregs.x.ax));
ASET (registers, 1, make_fixnum (outregs.x.bx));
ASET (registers, 2, make_fixnum (outregs.x.cx));
ASET (registers, 3, make_fixnum (outregs.x.dx));
ASET (registers, 4, make_fixnum (outregs.x.si));
ASET (registers, 5, make_fixnum (outregs.x.di));
ASET (registers, 6, make_fixnum (outregs.x.cflag));
ASET (registers, 7, make_fixnum (outregs.x.flags));
return registers;
}
@ -106,8 +106,8 @@ Return the updated VECTOR. */)
int offs, len;
char *buf;
CHECK_NUMBER (address);
offs = (unsigned long) XINT (address);
CHECK_FIXNUM (address);
offs = (unsigned long) XFIXNUM (address);
CHECK_VECTOR (vector);
len = ASIZE (vector);
if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len)
@ -116,7 +116,7 @@ Return the updated VECTOR. */)
dosmemget (offs, len, buf);
for (i = 0; i < len; i++)
ASET (vector, i, make_number (buf[i]));
ASET (vector, i, make_fixnum (buf[i]));
return vector;
}
@ -129,8 +129,8 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0,
int offs, len;
char *buf;
CHECK_NUMBER (address);
offs = (unsigned long) XINT (address);
CHECK_FIXNUM (address);
offs = (unsigned long) XFIXNUM (address);
CHECK_VECTOR (vector);
len = ASIZE (vector);
if (len < 1 || len > 2048 || offs < 0 || offs > 0xfffff - len)
@ -139,8 +139,8 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0,
for (i = 0; i < len; i++)
{
CHECK_NUMBER (AREF (vector, i));
buf[i] = (unsigned char) XFASTINT (AREF (vector, i)) & 0xFF;
CHECK_FIXNUM (AREF (vector, i));
buf[i] = (unsigned char) XFIXNAT (AREF (vector, i)) & 0xFF;
}
dosmemput (buf, len, offs);
@ -154,8 +154,8 @@ all keys; otherwise it is only used when the ALT key is pressed.
The current keyboard layout is available in dos-keyboard-code. */)
(Lisp_Object country_code, Lisp_Object allkeys)
{
CHECK_NUMBER (country_code);
if (!dos_set_keyboard (XINT (country_code), !NILP (allkeys)))
CHECK_FIXNUM (country_code);
if (!dos_set_keyboard (XFIXNUM (country_code), !NILP (allkeys)))
return Qnil;
return Qt;
}
@ -280,7 +280,7 @@ init_dosfns (void)
regs.x.ax = 0x3000;
intdos (&regs, &regs);
Vdos_version = Fcons (make_number (regs.h.al), make_number (regs.h.ah));
Vdos_version = Fcons (make_fixnum (regs.h.al), make_fixnum (regs.h.ah));
/* Obtain the country code via DPMI, use DJGPP transfer buffer. */
dpmiregs.x.ax = 0x3800;
@ -341,7 +341,7 @@ init_dosfns (void)
{
dos_windows_version = dpmiregs.x.ax;
Vdos_windows_version =
Fcons (make_number (dpmiregs.h.al), make_number (dpmiregs.h.ah));
Fcons (make_fixnum (dpmiregs.h.al), make_fixnum (dpmiregs.h.ah));
/* Save the current title of this virtual machine, so we can restore
it before exiting. Otherwise, Windows 95 will continue to use
@ -520,8 +520,8 @@ system_process_attributes (Lisp_Object pid)
int proc_id;
Lisp_Object attrs = Qnil;
CHECK_NUMBER_OR_FLOAT (pid);
proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XINT (pid);
CHECK_FIXNUM_OR_FLOAT (pid);
proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid);
if (proc_id == getpid ())
{
@ -555,13 +555,13 @@ system_process_attributes (Lisp_Object pid)
Vlocale_coding_system, 0);
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
/* Pretend we have 0 as PPID. */
attrs = Fcons (Fcons (Qppid, make_number (0)), attrs);
attrs = Fcons (Fcons (Qppid, make_fixnum (0)), attrs);
attrs = Fcons (Fcons (Qpgrp, pid), attrs);
attrs = Fcons (Fcons (Qttname, build_string ("/dev/tty")), attrs);
/* We are never idle! */
tem = Fget_internal_run_time ();
attrs = Fcons (Fcons (Qtime, tem), attrs);
attrs = Fcons (Fcons (Qthcount, make_number (1)), attrs);
attrs = Fcons (Fcons (Qthcount, make_fixnum (1)), attrs);
attrs = Fcons (Fcons (Qstart,
Fsymbol_value (intern ("before-init-time"))),
attrs);

447
src/editfns.c
View file

File diff suppressed because it is too large Load diff

47
src/emacs-module.c
View file

@ -302,15 +302,15 @@ module_make_global_ref (emacs_env *env, emacs_value ref)
if (i >= 0)
{
Lisp_Object value = HASH_VALUE (h, i);
EMACS_INT refcount = XFASTINT (value) + 1;
EMACS_INT refcount = XFIXNAT (value) + 1;
if (MOST_POSITIVE_FIXNUM < refcount)
xsignal0 (Qoverflow_error);
value = make_natnum (refcount);
value = make_fixed_natnum (refcount);
set_hash_value_slot (h, i, value);
}
else
{
hash_put (h, new_obj, make_natnum (1), hashcode);
hash_put (h, new_obj, make_fixed_natnum (1), hashcode);
}
return lisp_to_value (module_assertions ? global_env : env, new_obj);
@ -329,9 +329,9 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
if (i >= 0)
{
EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1;
EMACS_INT refcount = XFIXNAT (HASH_VALUE (h, i)) - 1;
if (refcount > 0)
set_hash_value_slot (h, i, make_natnum (refcount));
set_hash_value_slot (h, i, make_fixed_natnum (refcount));
else
{
eassert (refcount == 0);
@ -441,7 +441,7 @@ module_make_function (emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity,
? (min_arity <= MOST_POSITIVE_FIXNUM
&& max_arity == emacs_variadic_function)
: min_arity <= max_arity && max_arity <= MOST_POSITIVE_FIXNUM)))
xsignal2 (Qinvalid_arity, make_number (min_arity), make_number (max_arity));
xsignal2 (Qinvalid_arity, make_fixnum (min_arity), make_fixnum (max_arity));
struct Lisp_Module_Function *function = allocate_module_function ();
function->min_arity = min_arity;
@ -518,17 +518,32 @@ module_extract_integer (emacs_env *env, emacs_value n)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object l = value_to_lisp (n);
CHECK_NUMBER (l);
return XINT (l);
CHECK_INTEGER (l);
if (BIGNUMP (l))
{
if (!mpz_fits_slong_p (XBIGNUM (l)->value))
xsignal1 (Qoverflow_error, l);
return mpz_get_si (XBIGNUM (l)->value);
}
return XFIXNUM (l);
}
static emacs_value
module_make_integer (emacs_env *env, intmax_t n)
{
Lisp_Object obj;
MODULE_FUNCTION_BEGIN (module_nil);
if (FIXNUM_OVERFLOW_P (n))
xsignal0 (Qoverflow_error);
return lisp_to_value (env, make_number (n));
{
mpz_t val;
mpz_init (val);
mpz_set_intmax (val, n);
obj = make_number (val);
mpz_clear (val);
}
else
obj = make_fixnum (n);
return lisp_to_value (env, obj);
}
static double
@ -640,7 +655,7 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
CHECK_VECTOR (lvec);
if (! (0 <= i && i < ASIZE (lvec)))
args_out_of_range_3 (make_fixnum_or_float (i),
make_number (0), make_number (ASIZE (lvec) - 1));
make_fixnum (0), make_fixnum (ASIZE (lvec) - 1));
}
static void
@ -749,7 +764,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0,
{
if (FIXNUM_OVERFLOW_P (r))
xsignal0 (Qoverflow_error);
xsignal2 (Qmodule_init_failed, file, make_number (r));
xsignal2 (Qmodule_init_failed, file, make_fixnum (r));
}
module_signal_or_throw (&env_priv);
@ -763,7 +778,7 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
eassume (0 <= func->min_arity);
if (! (func->min_arity <= nargs
&& (func->max_arity < 0 || nargs <= func->max_arity)))
xsignal2 (Qwrong_number_of_arguments, function, make_number (nargs));
xsignal2 (Qwrong_number_of_arguments, function, make_fixnum (nargs));
emacs_env pub;
struct emacs_env_private priv;
@ -802,8 +817,8 @@ module_function_arity (const struct Lisp_Module_Function *const function)
{
ptrdiff_t minargs = function->min_arity;
ptrdiff_t maxargs = function->max_arity;
return Fcons (make_number (minargs),
maxargs == MANY ? Qmany : make_number (maxargs));
return Fcons (make_fixnum (minargs),
maxargs == MANY ? Qmany : make_fixnum (maxargs));
}
@ -991,7 +1006,7 @@ lisp_to_value_bits (Lisp_Object o)
/* Compress O into the space of a pointer, possibly losing information. */
EMACS_UINT u = XLI (o);
if (INTEGERP (o))
if (FIXNUMP (o))
{
uintptr_t i = (u << VALBITS) + XTYPE (o);
return (emacs_value) i;

48
src/emacs.c
View file

@ -377,7 +377,7 @@ terminate_due_to_signal (int sig, int backtrace_limit)
totally_unblock_input ();
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
Fkill_emacs (make_number (sig));
Fkill_emacs (make_fixnum (sig));
shut_down_emacs (sig, Qnil);
emacs_backtrace (backtrace_limit);
@ -446,7 +446,7 @@ init_cmdargs (int argc, char **argv, int skip_args, char *original_pwd)
{
Lisp_Object found;
int yes = openp (Vexec_path, Vinvocation_name,
Vexec_suffixes, &found, make_number (X_OK), false);
Vexec_suffixes, &found, make_fixnum (X_OK), false);
if (yes == 1)
{
/* Add /: to the front of the name
@ -673,6 +673,38 @@ close_output_streams (void)
_exit (EXIT_FAILURE);
}
/* Memory allocation functions for GMP. */
static void
check_bignum_size (size_t size)
{
/* Do not create a bignum whose log base 2 could exceed fixnum range.
This way, functions like mpz_popcount return values in fixnum range.
It may also help to avoid other problems with outlandish bignums. */
if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size)
error ("Integer too large to be represented");
}
static void * ATTRIBUTE_MALLOC
xmalloc_for_gmp (size_t size)
{
check_bignum_size (size);
return xmalloc (size);
}
static void *
xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
{
check_bignum_size (size);
return xrealloc (ptr, size);
}
static void
xfree_for_gmp (void *ptr, size_t ignore)
{
xfree (ptr);
}
/* ARGSUSED */
int
main (int argc, char **argv)
@ -771,6 +803,8 @@ main (int argc, char **argv)
init_standard_fds ();
atexit (close_output_streams);
mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp);
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
@ -2052,10 +2086,10 @@ all of which are called before Emacs is actually killed. */
unlink (SSDATA (listfile));
}
if (INTEGERP (arg))
exit_code = (XINT (arg) < 0
? XINT (arg) | INT_MIN
: XINT (arg) & INT_MAX);
if (FIXNUMP (arg))
exit_code = (XFIXNUM (arg) < 0
? XFIXNUM (arg) | INT_MIN
: XFIXNUM (arg) & INT_MAX);
else
exit_code = EXIT_SUCCESS;
exit (exit_code);
@ -2416,7 +2450,7 @@ decode_env_path (const char *evarname, const char *defalt, bool empty)
&& strncmp (path, emacs_dir_env, emacs_dir_len) == 0)
element = Fexpand_file_name (Fsubstring
(element,
make_number (emacs_dir_len),
make_fixnum (emacs_dir_len),
Qnil),
build_unibyte_string (emacs_dir));
#endif

56
src/eval.c
View file

@ -264,8 +264,8 @@ init_eval (void)
static void
restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
max_specpdl_size = XFIXNUM (XCAR (data));
max_lisp_eval_depth = XFIXNUM (XCDR (data));
}
static void grow_specpdl (void);
@ -303,8 +303,8 @@ call_debugger (Lisp_Object arg)
/* Restore limits after leaving the debugger. */
record_unwind_protect (restore_stack_limits,
Fcons (make_number (old_max),
make_number (old_depth)));
Fcons (make_fixnum (old_max),
make_fixnum (old_depth)));
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
@ -511,7 +511,7 @@ usage: (setq [SYM VAL]...) */)
Lisp_Object sym = XCAR (tail), lex_binding;
tail = XCDR (tail);
if (!CONSP (tail))
xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
xsignal2 (Qwrong_number_of_arguments, Qsetq, make_fixnum (nargs + 1));
Lisp_Object arg = XCAR (tail);
tail = XCDR (tail);
val = eval_sub (arg);
@ -938,7 +938,7 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
EMACS_INT varlist_len = XFASTINT (Flength (varlist));
EMACS_INT varlist_len = XFIXNAT (Flength (varlist));
SAFE_ALLOCA_LISP (temps, varlist_len);
ptrdiff_t nvars = varlist_len;
@ -1991,12 +1991,12 @@ this does nothing and returns nil. */)
&& !AUTOLOADP (XSYMBOL (function)->u.s.function))
return Qnil;
if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0)))
/* `read1' in lread.c has found the docstring starting with "\
and assumed the docstring will be provided by Snarf-documentation, so it
passed us 0 instead. But that leads to accidental sharing in purecopy's
hash-consing, so we use a (hopefully) unique integer instead. */
docstring = make_number (XHASH (function));
docstring = make_fixnum (XHASH (function));
return Fdefalias (function,
list5 (Qautoload, file, docstring, interactive, type),
Qnil);
@ -2016,7 +2016,7 @@ un_autoload (Lisp_Object oldqueue)
first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
if (EQ (first, make_number (0)))
if (EQ (first, make_fixnum (0)))
Vfeatures = second;
else
Ffset (first, second);
@ -2041,7 +2041,7 @@ it defines a macro. */)
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
return fundef;
Lisp_Object kind = Fnth (make_number (4), fundef);
Lisp_Object kind = Fnth (make_fixnum (4), fundef);
if (EQ (macro_only, Qmacro)
&& !(EQ (kind, Qt) || EQ (kind, Qmacro)))
return fundef;
@ -2230,9 +2230,9 @@ eval_sub (Lisp_Object form)
check_cons_list ();
if (XINT (numargs) < XSUBR (fun)->min_args
if (XFIXNUM (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
&& XSUBR (fun)->max_args < XINT (numargs)))
&& XSUBR (fun)->max_args < XFIXNUM (numargs)))
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
@ -2244,9 +2244,9 @@ eval_sub (Lisp_Object form)
ptrdiff_t argnum = 0;
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (vals, XINT (numargs));
SAFE_ALLOCA_LISP (vals, XFIXNUM (numargs));
while (CONSP (args_left) && argnum < XINT (numargs))
while (CONSP (args_left) && argnum < XFIXNUM (numargs))
{
Lisp_Object arg = XCAR (args_left);
args_left = XCDR (args_left);
@ -2276,7 +2276,7 @@ eval_sub (Lisp_Object form)
args_left = Fcdr (args_left);
}
set_backtrace_args (specpdl + count, argvals, XINT (numargs));
set_backtrace_args (specpdl + count, argvals, XFIXNUM (numargs));
switch (i)
{
@ -2389,7 +2389,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
CHECK_LIST (spread_arg);
numargs = XINT (Flength (spread_arg));
numargs = XFIXNUM (Flength (spread_arg));
if (numargs == 0)
return Ffuncall (nargs - 1, args);
@ -2863,7 +2863,7 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
{
Lisp_Object fun;
XSETSUBR (fun, subr);
xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs));
xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs));
}
else if (subr->max_args == UNEVALLED)
@ -2944,7 +2944,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
Lisp_Object tem;
USE_SAFE_ALLOCA;
numargs = XFASTINT (Flength (args));
numargs = XFIXNAT (Flength (args));
SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
@ -3006,7 +3006,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (size <= COMPILED_STACK_DEPTH)
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (INTEGERP (syms_left))
if (FIXNUMP (syms_left))
/* A byte-code object with an integer args template means we
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
@ -3067,7 +3067,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else if (i < nargs)
arg = arg_vector[i++];
else if (!optional)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
else
arg = Qnil;
@ -3084,7 +3084,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
else if (i < nargs)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
if (!EQ (lexenv, Vinternal_interpreter_environment))
/* Instantiate a new lexical environment. */
@ -3191,7 +3191,7 @@ lambda_arity (Lisp_Object fun)
if (size <= COMPILED_STACK_DEPTH)
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (INTEGERP (syms_left))
if (FIXNUMP (syms_left))
return get_byte_code_arity (syms_left);
}
else
@ -3206,7 +3206,7 @@ lambda_arity (Lisp_Object fun)
xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
return Fcons (make_number (minargs), Qmany);
return Fcons (make_fixnum (minargs), Qmany);
else if (EQ (next, Qand_optional))
optional = true;
else
@ -3220,7 +3220,7 @@ lambda_arity (Lisp_Object fun)
if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
return Fcons (make_number (minargs), make_number (maxargs));
return Fcons (make_fixnum (minargs), make_fixnum (maxargs));
}
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
@ -3647,11 +3647,11 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
{
register EMACS_INT i;
CHECK_NATNUM (nframes);
CHECK_FIXNAT (nframes);
union specbinding *pdl = get_backtrace_starting_at (base);
/* Find the frame requested. */
for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
for (i = XFIXNAT (nframes); i > 0 && backtrace_p (pdl); i--)
pdl = backtrace_next (pdl);
return pdl;
@ -3681,7 +3681,7 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
The debugger is entered when that frame exits, if the flag is non-nil. */)
(Lisp_Object level, Lisp_Object flag)
{
CHECK_NUMBER (level);
CHECK_FIXNUM (level);
union specbinding *pdl = get_backtrace_frame(level, Qnil);
if (backtrace_p (pdl))
@ -3852,7 +3852,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
{
union specbinding *frame = get_backtrace_frame (nframes, base);
union specbinding *prevframe
= get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base);
= get_backtrace_frame (make_fixnum (XFIXNAT (nframes) - 1), base);
ptrdiff_t distance = specpdl_ptr - frame;
Lisp_Object result = Qnil;
eassert (distance >= 0);

144
src/fileio.c
View file

@ -691,7 +691,7 @@ This function does not grok magic file names. */)
memset (data + prefix_len, 'X', nX);
memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
int kind = (NILP (dir_flag) ? GT_FILE
: EQ (dir_flag, make_number (0)) ? GT_NOCREATE
: EQ (dir_flag, make_fixnum (0)) ? GT_NOCREATE
: GT_DIR);
int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
bool failed = fd < 0;
@ -732,7 +732,7 @@ later creating the file, which opens all kinds of security holes.
For that reason, you should normally use `make-temp-file' instead. */)
(Lisp_Object prefix)
{
return Fmake_temp_file_internal (prefix, make_number (0),
return Fmake_temp_file_internal (prefix, make_fixnum (0),
empty_unibyte_string, Qnil);
}
@ -1945,9 +1945,9 @@ permissions. */)
#ifdef WINDOWSNT
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
|| FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, false, "copy to it",
INTEGERP (ok_if_already_exists), false);
FIXNUMP (ok_if_already_exists), false);
result = w32_copy_file (SSDATA (encoded_file), SSDATA (encoded_newname),
!NILP (keep_time), !NILP (preserve_uid_gid),
@ -2002,9 +2002,9 @@ permissions. */)
new_mask);
if (ofd < 0 && errno == EEXIST)
{
if (NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))
if (NILP (ok_if_already_exists) || FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, true, "copy to it",
INTEGERP (ok_if_already_exists), false);
FIXNUMP (ok_if_already_exists), false);
already_exists = true;
ofd = emacs_open (SSDATA (encoded_newname), O_WRONLY, 0);
}
@ -2365,7 +2365,7 @@ This is what happens in interactive use with M-x. */)
bool plain_rename = (case_only_rename
|| (!NILP (ok_if_already_exists)
&& !INTEGERP (ok_if_already_exists)));
&& !FIXNUMP (ok_if_already_exists)));
int rename_errno UNINIT;
if (!plain_rename)
{
@ -2383,7 +2383,7 @@ This is what happens in interactive use with M-x. */)
#endif
barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
"rename to it",
INTEGERP (ok_if_already_exists),
FIXNUMP (ok_if_already_exists),
false);
plain_rename = true;
break;
@ -2476,9 +2476,9 @@ This is what happens in interactive use with M-x. */)
if (errno == EEXIST)
{
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
|| FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (newname, true, "make it a new name",
INTEGERP (ok_if_already_exists), false);
FIXNUMP (ok_if_already_exists), false);
unlink (SSDATA (newname));
if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
return Qnil;
@ -2504,12 +2504,12 @@ This happens for interactive use with M-x. */)
Lisp_Object encoded_target, encoded_linkname;
CHECK_STRING (target);
if (INTEGERP (ok_if_already_exists))
if (FIXNUMP (ok_if_already_exists))
{
if (SREF (target, 0) == '~')
target = Fexpand_file_name (target, Qnil);
else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
target = Fsubstring_no_properties (target, make_number (2), Qnil);
target = Fsubstring_no_properties (target, make_fixnum (2), Qnil);
}
linkname = expand_cp_target (target, linkname);
@ -2533,9 +2533,9 @@ This happens for interactive use with M-x. */)
if (errno == EEXIST)
{
if (NILP (ok_if_already_exists)
|| INTEGERP (ok_if_already_exists))
|| FIXNUMP (ok_if_already_exists))
barf_or_query_if_file_exists (linkname, true, "make it a link",
INTEGERP (ok_if_already_exists), false);
FIXNUMP (ok_if_already_exists), false);
unlink (SSDATA (encoded_linkname));
if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
return Qnil;
@ -3191,7 +3191,7 @@ Return nil, if file does not exist or is not accessible. */)
if (stat (SSDATA (absname), &st) < 0)
return Qnil;
return make_number (st.st_mode & 07777);
return make_fixnum (st.st_mode & 07777);
}
DEFUN ("set-file-modes", Fset_file_modes, Sset_file_modes, 2, 2,
@ -3208,7 +3208,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
Lisp_Object handler;
absname = Fexpand_file_name (filename, BVAR (current_buffer, directory));
CHECK_NUMBER (mode);
CHECK_FIXNUM (mode);
/* If the file name has special constructs in it,
call the corresponding file handler. */
@ -3218,7 +3218,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
encoded_absname = ENCODE_FILE (absname);
if (chmod (SSDATA (encoded_absname), XINT (mode) & 07777) < 0)
if (chmod (SSDATA (encoded_absname), XFIXNUM (mode) & 07777) < 0)
report_file_error ("Doing chmod", absname);
return Qnil;
@ -3239,9 +3239,9 @@ by having the corresponding bit in the mask reset. */)
(Lisp_Object mode)
{
mode_t oldrealmask, oldumask, newumask;
CHECK_NUMBER (mode);
CHECK_FIXNUM (mode);
oldrealmask = realmask;
newumask = ~ XINT (mode) & 0777;
newumask = ~ XFIXNUM (mode) & 0777;
block_input ();
realmask = newumask;
@ -3401,12 +3401,12 @@ verify (alignof (union read_non_regular) % GCALIGNMENT == 0);
static Lisp_Object
read_non_regular (Lisp_Object state)
{
union read_non_regular *data = XINTPTR (state);
union read_non_regular *data = XFIXNUMPTR (state);
int nbytes = emacs_read_quit (data->s.fd,
((char *) BEG_ADDR + PT_BYTE - BEG_BYTE
+ data->s.inserted),
data->s.trytry);
return make_number (nbytes);
return make_fixnum (nbytes);
}
@ -3424,8 +3424,8 @@ read_non_regular_quit (Lisp_Object ignore)
static off_t
file_offset (Lisp_Object val)
{
if (RANGED_INTEGERP (0, val, TYPE_MAXIMUM (off_t)))
return XINT (val);
if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t)))
return XFIXNUM (val);
if (FLOATP (val))
{
@ -3484,16 +3484,16 @@ restore_window_points (Lisp_Object window_markers, ptrdiff_t inserted,
Lisp_Object car = XCAR (window_markers);
Lisp_Object marker = XCAR (car);
Lisp_Object oldpos = XCDR (car);
if (MARKERP (marker) && INTEGERP (oldpos)
&& XINT (oldpos) > same_at_start
&& XINT (oldpos) < same_at_end)
if (MARKERP (marker) && FIXNUMP (oldpos)
&& XFIXNUM (oldpos) > same_at_start
&& XFIXNUM (oldpos) < same_at_end)
{
ptrdiff_t oldsize = same_at_end - same_at_start;
ptrdiff_t newsize = inserted;
double growth = newsize / (double)oldsize;
ptrdiff_t newpos
= same_at_start + growth * (XINT (oldpos) - same_at_start);
Fset_marker (marker, make_number (newpos), Qnil);
= same_at_start + growth * (XFIXNUM (oldpos) - same_at_start);
Fset_marker (marker, make_fixnum (newpos), Qnil);
}
}
}
@ -3606,8 +3606,8 @@ by calling `format-decode', which see. */)
val = call6 (handler, Qinsert_file_contents, filename,
visit, beg, end, replace);
if (CONSP (val) && CONSP (XCDR (val))
&& RANGED_INTEGERP (0, XCAR (XCDR (val)), ZV - PT))
inserted = XINT (XCAR (XCDR (val)));
&& RANGED_FIXNUMP (0, XCAR (XCDR (val)), ZV - PT))
inserted = XFIXNUM (XCAR (XCDR (val)));
goto handled;
}
@ -3792,7 +3792,7 @@ by calling `format-decode', which see. */)
insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0);
TEMP_SET_PT_BOTH (BEG, BEG_BYTE);
coding_system = call2 (Vset_auto_coding_function,
filename, make_number (nread));
filename, make_fixnum (nread));
set_buffer_internal (prev);
/* Discard the unwind protect for recovering the
@ -4271,7 +4271,7 @@ by calling `format-decode', which see. */)
break;
}
this = XINT (nbytes);
this = XFIXNUM (nbytes);
}
else
{
@ -4367,7 +4367,7 @@ by calling `format-decode', which see. */)
if (inserted > 0 && ! NILP (Vset_auto_coding_function))
{
coding_system = call2 (Vset_auto_coding_function,
filename, make_number (inserted));
filename, make_fixnum (inserted));
}
if (NILP (coding_system))
@ -4486,13 +4486,13 @@ by calling `format-decode', which see. */)
if (! NILP (Ffboundp (Qafter_insert_file_set_coding)))
{
insval = call2 (Qafter_insert_file_set_coding, make_number (inserted),
insval = call2 (Qafter_insert_file_set_coding, make_fixnum (inserted),
visit);
if (! NILP (insval))
{
if (! RANGED_INTEGERP (0, insval, ZV - PT))
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
inserted = XFIXNAT (insval);
}
}
@ -4512,10 +4512,10 @@ by calling `format-decode', which see. */)
if (NILP (replace))
{
insval = call3 (Qformat_decode,
Qnil, make_number (inserted), visit);
if (! RANGED_INTEGERP (0, insval, ZV - PT))
Qnil, make_fixnum (inserted), visit);
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
inserted = XFIXNAT (insval);
}
else
{
@ -4535,8 +4535,8 @@ by calling `format-decode', which see. */)
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call3 (Qformat_decode,
Qnil, make_number (oinserted), visit);
if (! RANGED_INTEGERP (0, insval, ZV - PT))
Qnil, make_fixnum (oinserted), visit);
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* format_decode didn't modify buffer's characters => move
@ -4546,7 +4546,7 @@ by calling `format-decode', which see. */)
else
/* format_decode modified buffer's characters => consider
entire buffer changed and leave point at point-min. */
inserted = XFASTINT (insval);
inserted = XFIXNAT (insval);
}
/* For consistency with format-decode call these now iff inserted > 0
@ -4556,12 +4556,12 @@ by calling `format-decode', which see. */)
{
if (NILP (replace))
{
insval = call1 (XCAR (p), make_number (inserted));
insval = call1 (XCAR (p), make_fixnum (inserted));
if (!NILP (insval))
{
if (! RANGED_INTEGERP (0, insval, ZV - PT))
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
inserted = XFASTINT (insval);
inserted = XFIXNAT (insval);
}
}
else
@ -4574,10 +4574,10 @@ by calling `format-decode', which see. */)
EMACS_INT ochars_modiff = CHARS_MODIFF;
TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE);
insval = call1 (XCAR (p), make_number (oinserted));
insval = call1 (XCAR (p), make_fixnum (oinserted));
if (!NILP (insval))
{
if (! RANGED_INTEGERP (0, insval, ZV - PT))
if (! RANGED_FIXNUMP (0, insval, ZV - PT))
wrong_type_argument (intern ("inserted-chars"), insval);
if (ochars_modiff == CHARS_MODIFF)
/* after_insert_file_functions didn't modify
@ -4589,7 +4589,7 @@ by calling `format-decode', which see. */)
/* after_insert_file_functions did modify buffer's
characters => consider entire buffer changed and
leave point at point-min. */
inserted = XFASTINT (insval);
inserted = XFIXNAT (insval);
}
}
@ -4605,10 +4605,10 @@ by calling `format-decode', which see. */)
/* Adjust the last undo record for the size change during
the format conversion. */
Lisp_Object tem = XCAR (old_undo);
if (CONSP (tem) && INTEGERP (XCAR (tem))
&& INTEGERP (XCDR (tem))
&& XFASTINT (XCDR (tem)) == PT + old_inserted)
XSETCDR (tem, make_number (PT + inserted));
if (CONSP (tem) && FIXNUMP (XCAR (tem))
&& FIXNUMP (XCDR (tem))
&& XFIXNAT (XCDR (tem)) == PT + old_inserted)
XSETCDR (tem, make_fixnum (PT + inserted));
}
}
else
@ -4643,7 +4643,7 @@ by calling `format-decode', which see. */)
/* Retval needs to be dealt with in all cases consistently. */
if (NILP (val))
val = list2 (orig_filename, make_number (inserted));
val = list2 (orig_filename, make_fixnum (inserted));
return unbind_to (count, val);
}
@ -4946,7 +4946,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
fn = SSDATA (encoded_filename);
open_flags = O_WRONLY | O_CREAT;
open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
if (NUMBERP (append))
if (FIXED_OR_FLOATP (append))
offset = file_offset (append);
else if (!NILP (append))
open_flags |= O_APPEND;
@ -4971,7 +4971,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
record_unwind_protect_int (close_file_unwind, desc);
}
if (NUMBERP (append))
if (FIXED_OR_FLOATP (append))
{
off_t ret = lseek (desc, offset, SEEK_SET);
if (ret < 0)
@ -4985,14 +4985,14 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
if (STRINGP (start))
ok = a_write (desc, start, 0, SCHARS (start), &annotations, &coding);
else if (XINT (start) != XINT (end))
ok = a_write (desc, Qnil, XINT (start), XINT (end) - XINT (start),
else if (XFIXNUM (start) != XFIXNUM (end))
ok = a_write (desc, Qnil, XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
&annotations, &coding);
else
{
/* If file was empty, still need to write the annotations. */
coding.mode |= CODING_MODE_LAST_BLOCK;
ok = a_write (desc, Qnil, XINT (end), 0, &annotations, &coding);
ok = a_write (desc, Qnil, XFIXNUM (end), 0, &annotations, &coding);
}
save_errno = errno;
@ -5154,7 +5154,7 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
}
if (!auto_saving && !noninteractive)
message_with_string ((NUMBERP (append)
message_with_string ((FIXED_OR_FLOATP (append)
? "Updated %s"
: ! NILP (append)
? "Added to %s"
@ -5239,7 +5239,7 @@ build_annotations (Lisp_Object start, Lisp_Object end)
has written annotations to a temporary buffer, which is now
current. */
res = call5 (Qformat_annotate_function, XCAR (p), start, end,
original_buffer, make_number (i));
original_buffer, make_fixnum (i));
if (current_buffer != given_buffer)
{
XSETFASTINT (start, BEGV);
@ -5278,8 +5278,8 @@ a_write (int desc, Lisp_Object string, ptrdiff_t pos,
{
tem = Fcar_safe (Fcar (*annot));
nextpos = pos - 1;
if (INTEGERP (tem))
nextpos = XFASTINT (tem);
if (FIXNUMP (tem))
nextpos = XFIXNAT (tem);
/* If there are no more annotations in this range,
output the rest of the range all at once. */
@ -5460,7 +5460,7 @@ See Info node `(elisp)Modification Time' for more details. */)
{
int ns = current_buffer->modtime.tv_nsec;
if (ns < 0)
return make_number (UNKNOWN_MODTIME_NSECS - ns);
return make_fixnum (UNKNOWN_MODTIME_NSECS - ns);
return make_lisp_time (current_buffer->modtime);
}
@ -5478,10 +5478,10 @@ An argument specifies the modification time value to use
if (!NILP (time_flag))
{
struct timespec mtime;
if (INTEGERP (time_flag))
if (FIXNUMP (time_flag))
{
CHECK_RANGED_INTEGER (time_flag, -1, 0);
mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XINT (time_flag));
mtime = make_timespec (0, UNKNOWN_MODTIME_NSECS - XFIXNUM (time_flag));
}
else
mtime = lisp_time_argument (time_flag);
@ -5547,9 +5547,9 @@ auto_save_1 (void)
/* But make sure we can overwrite it later! */
auto_save_mode_bits = (st.st_mode | 0600) & 0777;
else if (modes = Ffile_modes (BVAR (current_buffer, filename)),
INTEGERP (modes))
FIXNUMP (modes))
/* Remote files don't cooperate with stat. */
auto_save_mode_bits = (XINT (modes) | 0600) & 0777;
auto_save_mode_bits = (XFIXNUM (modes) | 0600) & 0777;
}
return
@ -5716,7 +5716,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
&& BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)
&& BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b)
/* -1 means we've turned off autosaving for a while--see below. */
&& XINT (BVAR (b, save_length)) >= 0
&& XFIXNUM (BVAR (b, save_length)) >= 0
&& (do_handled_files
|| NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name),
Qwrite_region))))
@ -5731,11 +5731,11 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
set_buffer_internal (b);
if (NILP (Vauto_save_include_big_deletions)
&& (XFASTINT (BVAR (b, save_length)) * 10
&& (XFIXNAT (BVAR (b, save_length)) * 10
> (BUF_Z (b) - BUF_BEG (b)) * 13)
/* A short file is likely to change a large fraction;
spare the user annoying messages. */
&& XFASTINT (BVAR (b, save_length)) > 5000
&& XFIXNAT (BVAR (b, save_length)) > 5000
/* These messages are frequent and annoying for `*mail*'. */
&& !NILP (BVAR (b, filename))
&& NILP (no_message))
@ -5748,7 +5748,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
/* Turn off auto-saving until there's a real save,
and prevent any more warnings. */
XSETINT (BVAR (b, save_length), -1);
Fsleep_for (make_number (1), Qnil);
Fsleep_for (make_fixnum (1), Qnil);
continue;
}
if (!auto_saved && NILP (no_message))
@ -5777,7 +5777,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
{
/* If we are going to restore an old message,
give time to read ours. */
sit_for (make_number (1), 0, 0);
sit_for (make_fixnum (1), 0, 0);
restore_message ();
}
else if (!auto_save_error_occurred)

81
src/floatfns.c
View file

@ -60,7 +60,7 @@ CHECK_FLOAT (Lisp_Object x)
double
extract_float (Lisp_Object num)
{
CHECK_NUMBER_OR_FLOAT (num);
CHECK_NUMBER (num);
return XFLOATINT (num);
}
@ -178,7 +178,7 @@ If X is zero, both parts (SGNFCAND and EXP) are zero. */)
double f = extract_float (x);
int exponent;
double sgnfcand = frexp (f, &exponent);
return Fcons (make_float (sgnfcand), make_number (exponent));
return Fcons (make_float (sgnfcand), make_fixnum (exponent));
}
DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0,
@ -186,8 +186,8 @@ DEFUN ("ldexp", Fldexp, Sldexp, 2, 2, 0,
EXPONENT must be an integer. */)
(Lisp_Object sgnfcand, Lisp_Object exponent)
{
CHECK_NUMBER (exponent);
int e = min (max (INT_MIN, XINT (exponent)), INT_MAX);
CHECK_FIXNUM (exponent);
int e = min (max (INT_MIN, XFIXNUM (exponent)), INT_MAX);
return make_float (ldexp (extract_float (sgnfcand), e));
}
@ -204,18 +204,18 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
doc: /* Return the exponential ARG1 ** ARG2. */)
(Lisp_Object arg1, Lisp_Object arg2)
{
CHECK_NUMBER_OR_FLOAT (arg1);
CHECK_NUMBER_OR_FLOAT (arg2);
if (INTEGERP (arg1) /* common lisp spec */
&& INTEGERP (arg2) /* don't promote, if both are ints, and */
&& XINT (arg2) >= 0) /* we are sure the result is not fractional */
CHECK_FIXNUM_OR_FLOAT (arg1);
CHECK_FIXNUM_OR_FLOAT (arg2);
if (FIXNUMP (arg1) /* common lisp spec */
&& FIXNUMP (arg2) /* don't promote, if both are ints, and */
&& XFIXNUM (arg2) >= 0) /* we are sure the result is not fractional */
{ /* this can be improved by pre-calculating */
EMACS_INT y; /* some binary powers of x then accumulating */
EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */
Lisp_Object val;
x = XINT (arg1);
y = XINT (arg2);
x = XFIXNUM (arg1);
y = XFIXNUM (arg2);
acc = (y & 1 ? x : 1);
while ((y >>= 1) != 0)
@ -268,12 +268,28 @@ DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
doc: /* Return the absolute value of ARG. */)
(register Lisp_Object arg)
{
CHECK_NUMBER_OR_FLOAT (arg);
CHECK_NUMBER (arg);
if (FLOATP (arg))
if (BIGNUMP (arg))
{
mpz_t val;
mpz_init (val);
mpz_abs (val, XBIGNUM (arg)->value);
arg = make_number (val);
mpz_clear (val);
}
else if (FIXNUMP (arg) && XFIXNUM (arg) == MOST_NEGATIVE_FIXNUM)
{
mpz_t val;
mpz_init (val);
mpz_set_intmax (val, - MOST_NEGATIVE_FIXNUM);
arg = make_number (val);
mpz_clear (val);
}
else if (FLOATP (arg))
arg = make_float (fabs (XFLOAT_DATA (arg)));
else if (XINT (arg) < 0)
XSETINT (arg, - XINT (arg));
else if (XFIXNUM (arg) < 0)
XSETINT (arg, - XFIXNUM (arg));
return arg;
}
@ -282,10 +298,12 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
doc: /* Return the floating point number equal to ARG. */)
(register Lisp_Object arg)
{
CHECK_NUMBER_OR_FLOAT (arg);
CHECK_NUMBER (arg);
if (INTEGERP (arg))
return make_float ((double) XINT (arg));
if (BIGNUMP (arg))
return make_float (mpz_get_d (XBIGNUM (arg)->value));
if (FIXNUMP (arg))
return make_float ((double) XFIXNUM (arg));
else /* give 'em the same float back */
return arg;
}
@ -304,7 +322,7 @@ This is the same as the exponent of a float. */)
(Lisp_Object arg)
{
EMACS_INT value;
CHECK_NUMBER_OR_FLOAT (arg);
CHECK_NUMBER (arg);
if (FLOATP (arg))
{
@ -321,15 +339,18 @@ This is the same as the exponent of a float. */)
else
value = MOST_POSITIVE_FIXNUM;
}
else if (BIGNUMP (arg))
value = mpz_sizeinbase (XBIGNUM (arg)->value, 2) - 1;
else
{
EMACS_INT i = eabs (XINT (arg));
eassert (FIXNUMP (arg));
EMACS_INT i = eabs (XFIXNUM (arg));
value = (i == 0
? MOST_NEGATIVE_FIXNUM
: EMACS_UINT_WIDTH - 1 - ecount_leading_zeros (i));
}
return make_number (value);
return make_fixnum (value);
}
@ -341,7 +362,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT),
const char *name)
{
CHECK_NUMBER_OR_FLOAT (arg);
CHECK_FIXNUM_OR_FLOAT (arg);
double d;
if (NILP (divisor))
@ -352,16 +373,16 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
}
else
{
CHECK_NUMBER_OR_FLOAT (divisor);
CHECK_FIXNUM_OR_FLOAT (divisor);
if (!FLOATP (arg) && !FLOATP (divisor))
{
if (XINT (divisor) == 0)
if (XFIXNUM (divisor) == 0)
xsignal0 (Qarith_error);
return make_number (int_round2 (XINT (arg), XINT (divisor)));
return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor)));
}
double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg);
double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor);
double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg);
double f2 = FLOATP (divisor) ? XFLOAT_DATA (divisor) : XFIXNUM (divisor);
if (! IEEE_FLOATING_POINT && f2 == 0)
xsignal0 (Qarith_error);
d = f1 / f2;
@ -376,7 +397,7 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
{
EMACS_INT ir = dr;
if (! FIXNUM_OVERFLOW_P (ir))
return make_number (ir);
return make_fixnum (ir);
}
xsignal2 (Qrange_error, build_string (name), arg);
}
@ -482,8 +503,8 @@ fmod_float (Lisp_Object x, Lisp_Object y)
{
double f1, f2;
f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x);
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y);
f1 = FLOATP (x) ? XFLOAT_DATA (x) : XFIXNUM (x);
f2 = FLOATP (y) ? XFLOAT_DATA (y) : XFIXNUM (y);
f1 = fmod (f1, f2);

298
src/fns.c
View file

@ -77,18 +77,18 @@ See Info node `(elisp)Random Numbers' for more details. */)
seed_random (SSDATA (limit), SBYTES (limit));
val = get_random ();
if (INTEGERP (limit) && 0 < XINT (limit))
if (FIXNUMP (limit) && 0 < XFIXNUM (limit))
while (true)
{
/* Return the remainder, except reject the rare case where
get_random returns a number so close to INTMASK that the
remainder isn't random. */
EMACS_INT remainder = val % XINT (limit);
if (val - remainder <= INTMASK - XINT (limit) + 1)
return make_number (remainder);
EMACS_INT remainder = val % XFIXNUM (limit);
if (val - remainder <= INTMASK - XFIXNUM (limit) + 1)
return make_fixnum (remainder);
val = get_random ();
}
return make_number (val);
return make_fixnum (val);
}
/* Random data-structure functions. */
@ -121,7 +121,7 @@ To get the number of bytes, use `string-bytes'. */)
CHECK_LIST_END (sequence, sequence);
if (MOST_POSITIVE_FIXNUM < i)
error ("List too long");
val = make_number (i);
val = make_fixnum (i);
}
else if (NILP (sequence))
XSETFASTINT (val, 0);
@ -163,7 +163,7 @@ A proper list is neither circular nor dotted (i.e., its last cdr is nil). */
return Qnil;
if (MOST_POSITIVE_FIXNUM < len)
xsignal0 (Qoverflow_error);
return make_number (len);
return make_fixnum (len);
}
DEFUN ("string-bytes", Fstring_bytes, Sstring_bytes, 1, 1, 0,
@ -172,7 +172,7 @@ If STRING is multibyte, this may be greater than the length of STRING. */)
(Lisp_Object string)
{
CHECK_STRING (string);
return make_number (SBYTES (string));
return make_fixnum (SBYTES (string));
}
DEFUN ("string-distance", Fstring_distance, Sstring_distance, 2, 3, 0,
@ -238,7 +238,7 @@ Letter-case is significant, but text properties are ignored. */)
}
SAFE_FREE ();
return make_number (column[len1]);
return make_fixnum (column[len1]);
}
DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
@ -292,10 +292,10 @@ If string STR1 is greater, the value is a positive number N;
/* For backward compatibility, silently bring too-large positive end
values into range. */
if (INTEGERP (end1) && SCHARS (str1) < XINT (end1))
end1 = make_number (SCHARS (str1));
if (INTEGERP (end2) && SCHARS (str2) < XINT (end2))
end2 = make_number (SCHARS (str2));
if (FIXNUMP (end1) && SCHARS (str1) < XFIXNUM (end1))
end1 = make_fixnum (SCHARS (str1));
if (FIXNUMP (end2) && SCHARS (str2) < XFIXNUM (end2))
end2 = make_fixnum (SCHARS (str2));
validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1);
validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2);
@ -320,8 +320,8 @@ If string STR1 is greater, the value is a positive number N;
if (! NILP (ignore_case))
{
c1 = XINT (Fupcase (make_number (c1)));
c2 = XINT (Fupcase (make_number (c2)));
c1 = XFIXNUM (Fupcase (make_fixnum (c1)));
c2 = XFIXNUM (Fupcase (make_fixnum (c2)));
}
if (c1 == c2)
@ -331,15 +331,15 @@ If string STR1 is greater, the value is a positive number N;
past the character that we are comparing;
hence we don't add or subtract 1 here. */
if (c1 < c2)
return make_number (- i1 + from1);
return make_fixnum (- i1 + from1);
else
return make_number (i1 - from1);
return make_fixnum (i1 - from1);
}
if (i1 < to1)
return make_number (i1 - from1 + 1);
return make_fixnum (i1 - from1 + 1);
if (i2 < to2)
return make_number (- i1 + from1 - 1);
return make_fixnum (- i1 + from1 - 1);
return Qt;
}
@ -667,7 +667,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
EMACS_INT len;
this = args[argnum];
len = XFASTINT (Flength (this));
len = XFIXNAT (Flength (this));
if (target_type == Lisp_String)
{
/* We must count the number of bytes needed in the string
@ -682,7 +682,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
ch = AREF (this, i);
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
c = XFIXNAT (ch);
this_len_byte = CHAR_BYTES (c);
if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
string_overflow ();
@ -691,13 +691,13 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
some_multibyte = 1;
}
else if (BOOL_VECTOR_P (this) && bool_vector_size (this) > 0)
wrong_type_argument (Qintegerp, Faref (this, make_number (0)));
wrong_type_argument (Qintegerp, Faref (this, make_fixnum (0)));
else if (CONSP (this))
for (; CONSP (this); this = XCDR (this))
{
ch = XCAR (this);
CHECK_CHARACTER (ch);
c = XFASTINT (ch);
c = XFIXNAT (ch);
this_len_byte = CHAR_BYTES (c);
if (STRING_BYTES_BOUND - result_len_byte < this_len_byte)
string_overflow ();
@ -731,9 +731,9 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
/* Create the output object. */
if (target_type == Lisp_Cons)
val = Fmake_list (make_number (result_len), Qnil);
val = Fmake_list (make_fixnum (result_len), Qnil);
else if (target_type == Lisp_Vectorlike)
val = Fmake_vector (make_number (result_len), Qnil);
val = Fmake_vector (make_fixnum (result_len), Qnil);
else if (some_multibyte)
val = make_uninit_multibyte_string (result_len, result_len_byte);
else
@ -762,7 +762,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
this = args[argnum];
if (!CONSP (this))
thislen = Flength (this), thisleni = XINT (thislen);
thislen = Flength (this), thisleni = XFIXNUM (thislen);
/* Between strings of the same kind, copy fast. */
if (STRINGP (this) && STRINGP (val)
@ -849,7 +849,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
int c;
CHECK_CHARACTER (elt);
c = XFASTINT (elt);
c = XFIXNAT (elt);
if (some_multibyte)
toindex_byte += CHAR_STRING (c, SDATA (val) + toindex_byte);
else
@ -870,15 +870,15 @@ concat (ptrdiff_t nargs, Lisp_Object *args,
{
this = args[textprops[argnum].argnum];
props = text_property_list (this,
make_number (0),
make_number (SCHARS (this)),
make_fixnum (0),
make_fixnum (SCHARS (this)),
Qnil);
/* If successive arguments have properties, be sure that the
value of `composition' property be the copy. */
if (last_to_end == textprops[argnum].to)
make_composition_value_copy (props);
add_text_properties_from_list (val, props,
make_number (textprops[argnum].to));
make_fixnum (textprops[argnum].to));
last_to_end = textprops[argnum].to + SCHARS (this);
}
}
@ -1280,9 +1280,9 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to,
{
EMACS_INT f, t;
if (INTEGERP (from))
if (FIXNUMP (from))
{
f = XINT (from);
f = XFIXNUM (from);
if (f < 0)
f += size;
}
@ -1291,9 +1291,9 @@ validate_subarray (Lisp_Object array, Lisp_Object from, Lisp_Object to,
else
wrong_type_argument (Qintegerp, from);
if (INTEGERP (to))
if (FIXNUMP (to))
{
t = XINT (to);
t = XFIXNUM (to);
if (t < 0)
t += size;
}
@ -1339,8 +1339,8 @@ With one argument, just copy STRING (with properties, if any). */)
res = make_specified_string (SSDATA (string) + from_byte,
ito - ifrom, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (ifrom), make_number (ito),
string, make_number (0), res, Qnil);
copy_text_properties (make_fixnum (ifrom), make_fixnum (ito),
string, make_fixnum (0), res, Qnil);
}
else
res = Fvector (ito - ifrom, aref_addr (string, ifrom));
@ -1385,15 +1385,15 @@ substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte,
ptrdiff_t size = CHECK_VECTOR_OR_STRING (string);
if (!(0 <= from && from <= to && to <= size))
args_out_of_range_3 (string, make_number (from), make_number (to));
args_out_of_range_3 (string, make_fixnum (from), make_fixnum (to));
if (STRINGP (string))
{
res = make_specified_string (SSDATA (string) + from_byte,
to - from, to_byte - from_byte,
STRING_MULTIBYTE (string));
copy_text_properties (make_number (from), make_number (to),
string, make_number (0), res, Qnil);
copy_text_properties (make_fixnum (from), make_fixnum (to),
string, make_fixnum (0), res, Qnil);
}
else
res = Fvector (to - from, aref_addr (string, from));
@ -1405,9 +1405,9 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
doc: /* Take cdr N times on LIST, return the result. */)
(Lisp_Object n, Lisp_Object list)
{
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
Lisp_Object tail = list;
for (EMACS_INT num = XINT (n); 0 < num; num--)
for (EMACS_INT num = XFIXNUM (n); 0 < num; num--)
{
if (! CONSP (tail))
{
@ -1432,7 +1432,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
doc: /* Return element of SEQUENCE at index N. */)
(register Lisp_Object sequence, Lisp_Object n)
{
CHECK_NUMBER (n);
CHECK_FIXNUM (n);
if (CONSP (sequence) || NILP (sequence))
return Fcar (Fnthcdr (n, sequence));
@ -1690,7 +1690,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
if (!INTEGERP (elt) || c != XINT (elt))
if (!FIXNUMP (elt) || c != XFIXNUM (elt))
{
++nchars;
nbytes += cbytes;
@ -1720,7 +1720,7 @@ changing the value of a sequence `foo'. */)
cbytes = 1;
}
if (!INTEGERP (elt) || c != XINT (elt))
if (!FIXNUMP (elt) || c != XFIXNUM (elt))
{
unsigned char *from = SDATA (seq) + ibyte;
unsigned char *to = SDATA (tem) + nbytes;
@ -1891,7 +1891,7 @@ sort_list (Lisp_Object list, Lisp_Object predicate)
front = list;
len = Flength (list);
length = XINT (len);
length = XFIXNUM (len);
if (length < 2)
return list;
@ -2000,7 +2000,7 @@ sort_vector (Lisp_Object vector, Lisp_Object predicate)
USE_SAFE_ALLOCA;
SAFE_ALLOCA_LISP (tmp, halflen);
for (ptrdiff_t i = 0; i < halflen; i++)
tmp[i] = make_number (0);
tmp[i] = make_fixnum (0);
sort_vector_inplace (predicate, len, XVECTOR (vector)->contents, tmp);
SAFE_FREE ();
}
@ -2223,6 +2223,8 @@ This differs from numeric comparison: (eql 0.0 -0.0) returns nil and
{
if (FLOATP (obj1))
return FLOATP (obj2) && same_float (obj1, obj2) ? Qt : Qnil;
else if (BIGNUMP (obj1))
return equal_no_quit (obj1, obj2) ? Qt : Qnil;
else
return EQ (obj1, obj2) ? Qt : Qnil;
}
@ -2285,7 +2287,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
ht = CALLN (Fmake_hash_table, QCtest, Qeq);
switch (XTYPE (o1))
{
case Lisp_Cons: case Lisp_Misc: case Lisp_Vectorlike:
case Lisp_Cons: case Lisp_Vectorlike:
{
struct Lisp_Hash_Table *h = XHASH_TABLE (ht);
EMACS_UINT hash;
@ -2342,29 +2344,6 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
depth++;
goto tail_recurse;
case Lisp_Misc:
if (XMISCTYPE (o1) != XMISCTYPE (o2))
return false;
if (OVERLAYP (o1))
{
if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
equal_kind, depth + 1, ht)
|| !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
equal_kind, depth + 1, ht))
return false;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
depth++;
goto tail_recurse;
}
if (MARKERP (o1))
{
return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
&& (XMARKER (o1)->buffer == 0
|| XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
}
break;
case Lisp_Vectorlike:
{
register int i;
@ -2374,6 +2353,26 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum equal_kind equal_kind,
same size. */
if (ASIZE (o2) != size)
return false;
if (BIGNUMP (o1))
return mpz_cmp (XBIGNUM (o1)->value, XBIGNUM (o2)->value) == 0;
if (OVERLAYP (o1))
{
if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
equal_kind, depth + 1, ht)
|| !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
equal_kind, depth + 1, ht))
return false;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
depth++;
goto tail_recurse;
}
if (MARKERP (o1))
{
return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
&& (XMARKER (o1)->buffer == 0
|| XMARKER (o1)->bytepos == XMARKER (o2)->bytepos));
}
/* Boolvectors are compared much like strings. */
if (BOOL_VECTOR_P (o1))
{
@ -2456,7 +2455,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
register unsigned char *p = SDATA (array);
int charval;
CHECK_CHARACTER (item);
charval = XFASTINT (item);
charval = XFIXNAT (item);
size = SCHARS (array);
if (STRING_MULTIBYTE (array))
{
@ -2523,7 +2522,7 @@ usage: (nconc &rest LISTS) */)
CHECK_CONS (tem);
Lisp_Object tail;
Lisp_Object tail UNINIT;
FOR_EACH_TAIL (tem)
tail = tem;
@ -2608,7 +2607,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(Lisp_Object function, Lisp_Object sequence, Lisp_Object separator)
{
USE_SAFE_ALLOCA;
EMACS_INT leni = XFASTINT (Flength (sequence));
EMACS_INT leni = XFIXNAT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
EMACS_INT args_alloc = 2 * leni - 1;
@ -2637,7 +2636,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(Lisp_Object function, Lisp_Object sequence)
{
USE_SAFE_ALLOCA;
EMACS_INT leni = XFASTINT (Flength (sequence));
EMACS_INT leni = XFIXNAT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
Lisp_Object *args;
@ -2656,7 +2655,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
{
register EMACS_INT leni;
leni = XFASTINT (Flength (sequence));
leni = XFIXNAT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
mapcar1 (leni, 0, function, sequence);
@ -2671,7 +2670,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */)
(Lisp_Object function, Lisp_Object sequence)
{
USE_SAFE_ALLOCA;
EMACS_INT leni = XFASTINT (Flength (sequence));
EMACS_INT leni = XFIXNAT (Flength (sequence));
if (CHAR_TABLE_P (sequence))
wrong_type_argument (Qlistp, sequence);
Lisp_Object *args;
@ -2736,7 +2735,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
Fding (Qnil);
Fdiscard_input ();
message1 ("Please answer yes or no.");
Fsleep_for (make_number (2), Qnil);
Fsleep_for (make_fixnum (2), Qnil);
}
}
@ -2768,7 +2767,7 @@ advisable. */)
while (loads-- > 0)
{
Lisp_Object load = (NILP (use_floats)
? make_number (100.0 * load_ave[loads])
? make_fixnum (100.0 * load_ave[loads])
: make_float (load_ave[loads]));
ret = Fcons (load, ret);
}
@ -2804,7 +2803,7 @@ particular subfeatures supported in this version of FEATURE. */)
CHECK_SYMBOL (feature);
CHECK_LIST (subfeatures);
if (!NILP (Vautoload_queue))
Vautoload_queue = Fcons (Fcons (make_number (0), Vfeatures),
Vautoload_queue = Fcons (Fcons (make_fixnum (0), Vfeatures),
Vautoload_queue);
tem = Fmemq (feature, Vfeatures);
if (NILP (tem))
@ -3056,7 +3055,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
#ifdef DAY_1
else if (EQ (item, Qdays)) /* e.g. for calendar-day-name-array */
{
Lisp_Object v = Fmake_vector (make_number (7), Qnil);
Lisp_Object v = Fmake_vector (make_fixnum (7), Qnil);
const int days[7] = {DAY_1, DAY_2, DAY_3, DAY_4, DAY_5, DAY_6, DAY_7};
int i;
synchronize_system_time_locale ();
@ -3075,7 +3074,7 @@ The data read from the system are decoded using `locale-coding-system'. */)
#ifdef MON_1
else if (EQ (item, Qmonths)) /* e.g. for calendar-month-name-array */
{
Lisp_Object v = Fmake_vector (make_number (12), Qnil);
Lisp_Object v = Fmake_vector (make_fixnum (12), Qnil);
const int months[12] = {MON_1, MON_2, MON_3, MON_4, MON_5, MON_6, MON_7,
MON_8, MON_9, MON_10, MON_11, MON_12};
int i;
@ -3198,9 +3197,9 @@ into shorter lines. */)
validate_region (&beg, &end);
ibeg = CHAR_TO_BYTE (XFASTINT (beg));
iend = CHAR_TO_BYTE (XFASTINT (end));
move_gap_both (XFASTINT (beg), ibeg);
ibeg = CHAR_TO_BYTE (XFIXNAT (beg));
iend = CHAR_TO_BYTE (XFIXNAT (end));
move_gap_both (XFIXNAT (beg), ibeg);
/* We need to allocate enough room for encoding the text.
We need 33 1/3% more space, plus a newline every 76
@ -3225,21 +3224,21 @@ into shorter lines. */)
/* Now we have encoded the region, so we insert the new contents
and delete the old. (Insert first in order to preserve markers.) */
SET_PT_BOTH (XFASTINT (beg), ibeg);
SET_PT_BOTH (XFIXNAT (beg), ibeg);
insert (encoded, encoded_length);
SAFE_FREE ();
del_range_byte (ibeg + encoded_length, iend + encoded_length);
/* If point was outside of the region, restore it exactly; else just
move to the beginning of the region. */
if (old_pos >= XFASTINT (end))
old_pos += encoded_length - (XFASTINT (end) - XFASTINT (beg));
else if (old_pos > XFASTINT (beg))
old_pos = XFASTINT (beg);
if (old_pos >= XFIXNAT (end))
old_pos += encoded_length - (XFIXNAT (end) - XFIXNAT (beg));
else if (old_pos > XFIXNAT (beg))
old_pos = XFIXNAT (beg);
SET_PT (old_pos);
/* We return the length of the encoded text. */
return make_number (encoded_length);
return make_fixnum (encoded_length);
}
DEFUN ("base64-encode-string", Fbase64_encode_string, Sbase64_encode_string,
@ -3398,8 +3397,8 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
validate_region (&beg, &end);
ibeg = CHAR_TO_BYTE (XFASTINT (beg));
iend = CHAR_TO_BYTE (XFASTINT (end));
ibeg = CHAR_TO_BYTE (XFIXNAT (beg));
iend = CHAR_TO_BYTE (XFIXNAT (end));
length = iend - ibeg;
@ -3409,7 +3408,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
allength = multibyte ? length * 2 : length;
decoded = SAFE_ALLOCA (allength);
move_gap_both (XFASTINT (beg), ibeg);
move_gap_both (XFIXNAT (beg), ibeg);
decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
decoded, length,
multibyte, &inserted_chars);
@ -3424,24 +3423,24 @@ If the region can't be decoded, signal an error and don't modify the buffer. */
/* Now we have decoded the region, so we insert the new contents
and delete the old. (Insert first in order to preserve markers.) */
TEMP_SET_PT_BOTH (XFASTINT (beg), ibeg);
TEMP_SET_PT_BOTH (XFIXNAT (beg), ibeg);
insert_1_both (decoded, inserted_chars, decoded_length, 0, 1, 0);
signal_after_change (XFASTINT (beg), 0, inserted_chars);
signal_after_change (XFIXNAT (beg), 0, inserted_chars);
SAFE_FREE ();
/* Delete the original text. */
del_range_both (PT, PT_BYTE, XFASTINT (end) + inserted_chars,
del_range_both (PT, PT_BYTE, XFIXNAT (end) + inserted_chars,
iend + decoded_length, 1);
/* If point was outside of the region, restore it exactly; else just
move to the beginning of the region. */
if (old_pos >= XFASTINT (end))
old_pos += inserted_chars - (XFASTINT (end) - XFASTINT (beg));
else if (old_pos > XFASTINT (beg))
old_pos = XFASTINT (beg);
if (old_pos >= XFIXNAT (end))
old_pos += inserted_chars - (XFIXNAT (end) - XFIXNAT (beg));
else if (old_pos > XFIXNAT (beg))
old_pos = XFIXNAT (beg);
SET_PT (old_pos > ZV ? ZV : old_pos);
return make_number (inserted_chars);
return make_fixnum (inserted_chars);
}
DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
@ -3612,7 +3611,7 @@ set_hash_next (struct Lisp_Hash_Table *h, Lisp_Object next)
static void
set_hash_next_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
{
gc_aset (h->next, idx, make_number (val));
gc_aset (h->next, idx, make_fixnum (val));
}
static void
set_hash_hash (struct Lisp_Hash_Table *h, Lisp_Object hash)
@ -3632,7 +3631,7 @@ set_hash_index (struct Lisp_Hash_Table *h, Lisp_Object index)
static void
set_hash_index_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, ptrdiff_t val)
{
gc_aset (h->index, idx, make_number (val));
gc_aset (h->index, idx, make_fixnum (val));
}
/* If OBJ is a Lisp hash table, return a pointer to its struct
@ -3735,7 +3734,7 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
static ptrdiff_t
HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return XINT (AREF (h->next, idx));
return XFIXNUM (AREF (h->next, idx));
}
/* Return the index of the element in hash table H that is the start
@ -3744,7 +3743,7 @@ HASH_NEXT (struct Lisp_Hash_Table *h, ptrdiff_t idx)
static ptrdiff_t
HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx)
{
return XINT (AREF (h->index, idx));
return XFIXNUM (AREF (h->index, idx));
}
/* Compare KEY1 and KEY2 in hash table HT using `eql'. Value is true
@ -3755,7 +3754,13 @@ cmpfn_eql (struct hash_table_test *ht,
Lisp_Object key1,
Lisp_Object key2)
{
return FLOATP (key1) && FLOATP (key2) && same_float (key1, key2);
if (FLOATP (key1)
&& FLOATP (key2)
&& same_float (key1, key2))
return true;
return (BIGNUMP (key1)
&& BIGNUMP (key2)
&& mpz_cmp (XBIGNUM (key1)->value, XBIGNUM (key2)->value) == 0);
}
@ -3809,7 +3814,9 @@ hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
static EMACS_UINT
hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{
return FLOATP (key) ? hashfn_equal (ht, key) : hashfn_eq (ht, key);
return ((FLOATP (key) || BIGNUMP (key))
? hashfn_equal (ht, key)
: hashfn_eq (ht, key));
}
/* Value is a hash code for KEY for use in hash table H which uses as
@ -3908,10 +3915,10 @@ make_hash_table (struct hash_table_test test, EMACS_INT size,
h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size;
h->count = 0;
h->key_and_value = Fmake_vector (make_number (2 * size), Qnil);
h->hash = Fmake_vector (make_number (size), Qnil);
h->next = Fmake_vector (make_number (size), make_number (-1));
h->index = Fmake_vector (make_number (index_size), make_number (-1));
h->key_and_value = Fmake_vector (make_fixnum (2 * size), Qnil);
h->hash = Fmake_vector (make_fixnum (size), Qnil);
h->next = Fmake_vector (make_fixnum (size), make_fixnum (-1));
h->index = Fmake_vector (make_fixnum (index_size), make_fixnum (-1));
h->pure = pure;
/* Set up the free list. */
@ -4006,8 +4013,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
set_hash_key_and_value (h, larger_vector (h->key_and_value,
2 * (new_size - old_size), -1));
set_hash_hash (h, larger_vector (h->hash, new_size - old_size, -1));
set_hash_index (h, Fmake_vector (make_number (index_size),
make_number (-1)));
set_hash_index (h, Fmake_vector (make_fixnum (index_size),
make_fixnum (-1)));
set_hash_next (h, larger_vecalloc (h->next, new_size - old_size, -1));
/* Update the free list. Do it so that new entries are added at
@ -4036,7 +4043,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
for (i = 0; i < old_size; ++i)
if (!NILP (HASH_HASH (h, i)))
{
EMACS_UINT hash_code = XUINT (HASH_HASH (h, i));
EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i));
ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index);
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
set_hash_index_slot (h, start_of_bucket, i);
@ -4065,7 +4072,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
for (i = HASH_INDEX (h, start_of_bucket); 0 <= i; i = HASH_NEXT (h, i))
if (EQ (key, HASH_KEY (h, i))
|| (h->test.cmpfn
&& hash_code == XUINT (HASH_HASH (h, i))
&& hash_code == XUFIXNUM (HASH_HASH (h, i))
&& h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
break;
@ -4096,7 +4103,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value,
set_hash_value_slot (h, i, value);
/* Remember its hash code. */
set_hash_hash_slot (h, i, make_number (hash));
set_hash_hash_slot (h, i, make_fixnum (hash));
/* Add new entry to its collision chain. */
start_of_bucket = hash % ASIZE (h->index);
@ -4122,7 +4129,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
{
if (EQ (key, HASH_KEY (h, i))
|| (h->test.cmpfn
&& hash_code == XUINT (HASH_HASH (h, i))
&& hash_code == XUFIXNUM (HASH_HASH (h, i))
&& h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
{
/* Take entry out of collision chain. */
@ -4166,7 +4173,7 @@ hash_clear (struct Lisp_Hash_Table *h)
}
for (i = 0; i < ASIZE (h->index); ++i)
ASET (h->index, i, make_number (-1));
ASET (h->index, i, make_fixnum (-1));
h->next_free = 0;
h->count = 0;
@ -4433,6 +4440,20 @@ sxhash_bool_vector (Lisp_Object vec)
return SXHASH_REDUCE (hash);
}
/* Return a hash for a bignum. */
static EMACS_UINT
sxhash_bignum (struct Lisp_Bignum *bignum)
{
size_t i, nlimbs = mpz_size (bignum->value);
EMACS_UINT hash = 0;
for (i = 0; i < nlimbs; ++i)
hash = sxhash_combine (hash, mpz_getlimbn (bignum->value, i));
return SXHASH_REDUCE (hash);
}
/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp
structure. Value is an unsigned integer clipped to INTMASK. */
@ -4448,10 +4469,9 @@ sxhash (Lisp_Object obj, int depth)
switch (XTYPE (obj))
{
case_Lisp_Int:
hash = XUINT (obj);
hash = XUFIXNUM (obj);
break;
case Lisp_Misc:
case Lisp_Symbol:
hash = XHASH (obj);
break;
@ -4462,7 +4482,9 @@ sxhash (Lisp_Object obj, int depth)
/* This can be everything from a vector to an overlay. */
case Lisp_Vectorlike:
if (VECTORP (obj) || RECORDP (obj))
if (BIGNUMP (obj))
hash = sxhash_bignum (XBIGNUM (obj));
else if (VECTORP (obj) || RECORDP (obj))
/* According to the CL HyperSpec, two arrays are equal only if
they are `eq', except for strings and bit-vectors. In
Emacs, this works differently. We have to compare element
@ -4502,7 +4524,7 @@ DEFUN ("sxhash-eq", Fsxhash_eq, Ssxhash_eq, 1, 1, 0,
If (eq A B), then (= (sxhash-eq A) (sxhash-eq B)). */)
(Lisp_Object obj)
{
return make_number (hashfn_eq (NULL, obj));
return make_fixnum (hashfn_eq (NULL, obj));
}
DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
@ -4510,7 +4532,7 @@ DEFUN ("sxhash-eql", Fsxhash_eql, Ssxhash_eql, 1, 1, 0,
If (eql A B), then (= (sxhash-eql A) (sxhash-eql B)). */)
(Lisp_Object obj)
{
return make_number (hashfn_eql (NULL, obj));
return make_fixnum (hashfn_eql (NULL, obj));
}
DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
@ -4518,7 +4540,7 @@ DEFUN ("sxhash-equal", Fsxhash_equal, Ssxhash_equal, 1, 1, 0,
If (equal A B), then (= (sxhash-equal A) (sxhash-equal B)). */)
(Lisp_Object obj)
{
return make_number (hashfn_equal (NULL, obj));
return make_fixnum (hashfn_equal (NULL, obj));
}
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
@ -4604,8 +4626,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
EMACS_INT size;
if (NILP (size_arg))
size = DEFAULT_HASH_SIZE;
else if (NATNUMP (size_arg))
size = XFASTINT (size_arg);
else if (FIXNATP (size_arg))
size = XFIXNAT (size_arg);
else
signal_error ("Invalid hash table size", size_arg);
@ -4614,8 +4636,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
i = get_key_arg (QCrehash_size, nargs, args, used);
if (!i)
rehash_size = DEFAULT_REHASH_SIZE;
else if (INTEGERP (args[i]) && 0 < XINT (args[i]))
rehash_size = - XINT (args[i]);
else if (FIXNUMP (args[i]) && 0 < XFIXNUM (args[i]))
rehash_size = - XFIXNUM (args[i]);
else if (FLOATP (args[i]) && 0 < (float) (XFLOAT_DATA (args[i]) - 1))
rehash_size = (float) (XFLOAT_DATA (args[i]) - 1);
else
@ -4664,7 +4686,7 @@ DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0,
doc: /* Return the number of elements in TABLE. */)
(Lisp_Object table)
{
return make_number (check_hash_table (table)->count);
return make_fixnum (check_hash_table (table)->count);
}
@ -4677,7 +4699,7 @@ DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size,
if (rehash_size < 0)
{
EMACS_INT s = -rehash_size;
return make_number (min (s, MOST_POSITIVE_FIXNUM));
return make_fixnum (min (s, MOST_POSITIVE_FIXNUM));
}
else
return make_float (rehash_size + 1);
@ -4701,7 +4723,7 @@ without need for resizing. */)
(Lisp_Object table)
{
struct Lisp_Hash_Table *h = check_hash_table (table);
return make_number (HASH_TABLE_SIZE (h));
return make_fixnum (HASH_TABLE_SIZE (h));
}
@ -4929,16 +4951,16 @@ extract_data_from_object (Lisp_Object spec,
b = BEGV;
else
{
CHECK_NUMBER_COERCE_MARKER (start);
b = XINT (start);
CHECK_FIXNUM_COERCE_MARKER (start);
b = XFIXNUM (start);
}
if (NILP (end))
e = ZV;
else
{
CHECK_NUMBER_COERCE_MARKER (end);
e = XINT (end);
CHECK_FIXNUM_COERCE_MARKER (end);
e = XFIXNUM (end);
}
if (b > e)
@ -4993,7 +5015,7 @@ extract_data_from_object (Lisp_Object spec,
&& !NILP (Ffboundp (Vselect_safe_coding_system_function)))
/* Confirm that VAL can surely encode the current region. */
coding_system = call4 (Vselect_safe_coding_system_function,
make_number (b), make_number (e),
make_fixnum (b), make_fixnum (e),
coding_system, Qnil);
if (force_raw_text)
@ -5027,11 +5049,11 @@ extract_data_from_object (Lisp_Object spec,
#ifdef HAVE_GNUTLS3
/* Format: (iv-auto REQUIRED-LENGTH). */
if (! NATNUMP (start))
if (! FIXNATP (start))
error ("Without a length, `iv-auto' can't be used; see ELisp manual");
else
{
EMACS_INT start_hold = XFASTINT (start);
EMACS_INT start_hold = XFIXNAT (start);
object = make_uninit_string (start_hold);
gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);

434
src/font.c
View file

File diff suppressed because it is too large Load diff

14
src/font.h
View file

@ -185,16 +185,16 @@ enum font_property_index
/* Return the numeric weight value of FONT. */
#define FONT_WEIGHT_NUMERIC(font) \
(INTEGERP (AREF ((font), FONT_WEIGHT_INDEX)) \
? (XINT (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1)
(FIXNUMP (AREF ((font), FONT_WEIGHT_INDEX)) \
? (XFIXNUM (AREF ((font), FONT_WEIGHT_INDEX)) >> 8) : -1)
/* Return the numeric slant value of FONT. */
#define FONT_SLANT_NUMERIC(font) \
(INTEGERP (AREF ((font), FONT_SLANT_INDEX)) \
? (XINT (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1)
(FIXNUMP (AREF ((font), FONT_SLANT_INDEX)) \
? (XFIXNUM (AREF ((font), FONT_SLANT_INDEX)) >> 8) : -1)
/* Return the numeric width value of FONT. */
#define FONT_WIDTH_NUMERIC(font) \
(INTEGERP (AREF ((font), FONT_WIDTH_INDEX)) \
? (XINT (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1)
(FIXNUMP (AREF ((font), FONT_WIDTH_INDEX)) \
? (XFIXNUM (AREF ((font), FONT_WIDTH_INDEX)) >> 8) : -1)
/* Return the symbolic weight value of FONT. */
#define FONT_WEIGHT_SYMBOLIC(font) \
font_style_symbolic (font, FONT_WEIGHT_INDEX, false)
@ -228,7 +228,7 @@ enum font_property_index
style-related font property index (FONT_WEIGHT/SLANT/WIDTH_INDEX).
VAL (integer or symbol) is the numeric or symbolic style value. */
#define FONT_SET_STYLE(font, prop, val) \
ASET ((font), prop, make_number (font_style_to_value (prop, val, true)))
ASET ((font), prop, make_fixnum (font_style_to_value (prop, val, true)))
#ifndef MSDOS
#define FONT_WIDTH(f) ((f)->max_width)

147
src/fontset.c
View file

@ -266,7 +266,7 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
#define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
#define RFONT_DEF_SET_FACE(rfont_def, face_id) \
ASET ((rfont_def), 0, make_number (face_id))
ASET ((rfont_def), 0, make_fixnum (face_id))
#define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
#define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
#define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
@ -276,12 +276,12 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
the order of listing by font backends, the higher bits represents
the order given by charset priority list. The smaller value is
preferable. */
#define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
#define RFONT_DEF_SCORE(rfont_def) XFIXNUM (AREF (rfont_def, 3))
#define RFONT_DEF_SET_SCORE(rfont_def, score) \
ASET ((rfont_def), 3, make_number (score))
ASET ((rfont_def), 3, make_fixnum (score))
#define RFONT_DEF_NEW(rfont_def, font_def) \
do { \
(rfont_def) = Fmake_vector (make_number (4), Qnil); \
(rfont_def) = Fmake_vector (make_fixnum (4), Qnil); \
ASET ((rfont_def), 1, (font_def)); \
RFONT_DEF_SET_SCORE ((rfont_def), 0); \
} while (0)
@ -328,10 +328,10 @@ fontset_ref (Lisp_Object fontset, int c)
(NILP (add) \
? (NILP (range) \
? (set_fontset_fallback \
(fontset, Fmake_vector (make_number (1), (elt)))) \
(fontset, Fmake_vector (make_fixnum (1), (elt)))) \
: ((void) \
Fset_char_table_range (fontset, range, \
Fmake_vector (make_number (1), elt)))) \
Fmake_vector (make_fixnum (1), elt)))) \
: fontset_add ((fontset), (range), (elt), (add)))
static void
@ -340,12 +340,12 @@ fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Objec
Lisp_Object args[2];
int idx = (EQ (add, Qappend) ? 0 : 1);
args[1 - idx] = Fmake_vector (make_number (1), elt);
args[1 - idx] = Fmake_vector (make_fixnum (1), elt);
if (CONSP (range))
{
int from = XINT (XCAR (range));
int to = XINT (XCDR (range));
int from = XFIXNUM (XCAR (range));
int to = XFIXNUM (XCDR (range));
int from1, to1;
do {
@ -456,7 +456,7 @@ reorder_font_vector (Lisp_Object font_group, struct font *font)
qsort (XVECTOR (vec)->contents, size, word_size,
fontset_compare_rfontdef);
EMACS_INT low_tick_bits = charset_ordered_list_tick & MOST_POSITIVE_FIXNUM;
XSETCAR (font_group, make_number (low_tick_bits));
XSETCAR (font_group, make_fixnum (low_tick_bits));
}
/* Return a font-group (actually a cons (CHARSET_ORDERED_LIST_TICK
@ -496,7 +496,7 @@ fontset_get_font_group (Lisp_Object fontset, int c)
for C, or the fontset does not have fallback fonts. */
if (NILP (font_group))
{
font_group = make_number (0);
font_group = make_fixnum (0);
if (c >= 0)
/* Record that FONTSET does not specify fonts for C. As
there's a possibility that a font is found in a fallback
@ -520,7 +520,7 @@ fontset_get_font_group (Lisp_Object fontset, int c)
RFONT_DEF_SET_SCORE (rfont_def, i);
ASET (font_group, i, rfont_def);
}
font_group = Fcons (make_number (-1), font_group);
font_group = Fcons (make_fixnum (-1), font_group);
if (c >= 0)
char_table_set_range (fontset, from, to, font_group);
else
@ -561,7 +561,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face,
if (ASIZE (vec) > 1)
{
if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
if (XFIXNUM (XCAR (font_group)) != charset_ordered_list_tick)
/* We have just created the font-group,
or the charset priorities were changed. */
reorder_font_vector (font_group, face->ascii_face->font);
@ -577,7 +577,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face,
break;
repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
if (XINT (repertory) == charset_id)
if (XFIXNUM (repertory) == charset_id)
{
charset_matched = i;
break;
@ -633,8 +633,8 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face,
/* This is a sign of not to try the other fonts. */
return Qt;
}
if (INTEGERP (RFONT_DEF_FACE (rfont_def))
&& XINT (RFONT_DEF_FACE (rfont_def)) < 0)
if (FIXNUMP (RFONT_DEF_FACE (rfont_def))
&& XFIXNUM (RFONT_DEF_FACE (rfont_def)) < 0)
/* We couldn't open this font last time. */
continue;
@ -711,7 +711,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face,
RFONT_DEF_NEW (rfont_def, font_def);
RFONT_DEF_SET_OBJECT (rfont_def, font_object);
RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
new_vec = Fmake_vector (make_fixnum (ASIZE (vec) + 1), Qnil);
found_index++;
for (j = 0; j < found_index; j++)
ASET (new_vec, j, AREF (vec, j));
@ -727,7 +727,7 @@ fontset_find_font (Lisp_Object fontset, int c, struct face *face,
}
/* Record that no font in this font group supports C. */
FONTSET_SET (fontset, make_number (c), make_number (0));
FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
return Qnil;
found:
@ -756,12 +756,12 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
Lisp_Object base_fontset;
/* Try a font-group of FONTSET. */
FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
FONT_DEFERRED_LOG ("current fontset: font for", make_fixnum (c), Qnil);
rfont_def = fontset_find_font (fontset, c, face, id, 0);
if (VECTORP (rfont_def))
return rfont_def;
if (NILP (rfont_def))
FONTSET_SET (fontset, make_number (c), make_number (0));
FONTSET_SET (fontset, make_fixnum (c), make_fixnum (0));
/* Try a font-group of the default fontset. */
base_fontset = FONTSET_BASE (fontset);
@ -771,37 +771,37 @@ fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
set_fontset_default
(fontset,
make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
FONT_DEFERRED_LOG ("default fontset: font for", make_fixnum (c), Qnil);
default_rfont_def
= fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
if (VECTORP (default_rfont_def))
return default_rfont_def;
if (NILP (default_rfont_def))
FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
make_number (0));
FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c),
make_fixnum (0));
}
/* Try a fallback font-group of FONTSET. */
if (! EQ (rfont_def, Qt))
{
FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
FONT_DEFERRED_LOG ("current fallback: font for", make_fixnum (c), Qnil);
rfont_def = fontset_find_font (fontset, c, face, id, 1);
if (VECTORP (rfont_def))
return rfont_def;
/* Remember that FONTSET has no font for C. */
FONTSET_SET (fontset, make_number (c), Qt);
FONTSET_SET (fontset, make_fixnum (c), Qt);
}
/* Try a fallback font-group of the default fontset. */
if (! EQ (base_fontset, Vdefault_fontset)
&& ! EQ (default_rfont_def, Qt))
{
FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
FONT_DEFERRED_LOG ("default fallback: font for", make_fixnum (c), Qnil);
rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
if (VECTORP (rfont_def))
return rfont_def;
/* Remember that the default fontset has no font for C. */
FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
FONTSET_SET (FONTSET_DEFAULT (fontset), make_fixnum (c), Qt);
}
return Qnil;
@ -830,7 +830,7 @@ make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
fontset = Fmake_char_table (Qfontset, Qnil);
set_fontset_id (fontset, make_number (id));
set_fontset_id (fontset, make_fixnum (id));
if (NILP (base))
set_fontset_name (fontset, name);
else
@ -892,7 +892,7 @@ free_face_fontset (struct frame *f, struct face *face)
next_fontset_id = face->fontset;
if (! NILP (FONTSET_DEFAULT (fontset)))
{
int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
int id = XFIXNUM (FONTSET_ID (FONTSET_DEFAULT (fontset)));
fontset = AREF (Vfontset_table, id);
eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
@ -973,7 +973,7 @@ face_for_char (struct frame *f, struct face *face, int c,
}
else
{
charset = Fget_char_property (make_number (pos), Qcharset, object);
charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
if (CHARSETP (charset))
{
Lisp_Object val;
@ -981,7 +981,7 @@ face_for_char (struct frame *f, struct face *face, int c,
val = assq_no_quit (charset, Vfont_encoding_charset_alist);
if (CONSP (val) && CHARSETP (XCDR (val)))
charset = XCDR (val);
id = XINT (CHARSET_SYMBOL_ID (charset));
id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
}
else
id = -1;
@ -990,8 +990,8 @@ face_for_char (struct frame *f, struct face *face, int c,
rfont_def = fontset_font (fontset, c, face, id);
if (VECTORP (rfont_def))
{
if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
face_id = XINT (RFONT_DEF_FACE (rfont_def));
if (FIXNUMP (RFONT_DEF_FACE (rfont_def)))
face_id = XFIXNUM (RFONT_DEF_FACE (rfont_def));
else
{
Lisp_Object font_object;
@ -1003,12 +1003,12 @@ face_for_char (struct frame *f, struct face *face, int c,
}
else
{
if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
face_id = XINT (FONTSET_NOFONT_FACE (fontset));
if (FIXNUMP (FONTSET_NOFONT_FACE (fontset)))
face_id = XFIXNUM (FONTSET_NOFONT_FACE (fontset));
else
{
face_id = face_for_font (f, Qnil, face);
set_fontset_nofont_face (fontset, make_number (face_id));
set_fontset_nofont_face (fontset, make_fixnum (face_id));
}
}
eassert (face_id >= 0);
@ -1040,7 +1040,7 @@ font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
}
else
{
charset = Fget_char_property (make_number (pos), Qcharset, object);
charset = Fget_char_property (make_fixnum (pos), Qcharset, object);
if (CHARSETP (charset))
{
Lisp_Object val;
@ -1048,7 +1048,7 @@ font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
val = assq_no_quit (charset, Vfont_encoding_charset_alist);
if (CONSP (val) && CHARSETP (XCDR (val)))
charset = XCDR (val);
id = XINT (CHARSET_SYMBOL_ID (charset));
id = XFIXNUM (CHARSET_SYMBOL_ID (charset));
}
else
id = -1;
@ -1083,7 +1083,7 @@ make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *
base_fontset = Vdefault_fontset;
fontset = make_fontset (frame, Qnil, base_fontset);
return XINT (FONTSET_ID (fontset));
return XFIXNUM (FONTSET_ID (fontset));
}
@ -1306,7 +1306,7 @@ free_realized_fontsets (Lisp_Object base)
tail = XCDR (tail))
{
struct frame *f = XFRAME (FONTSET_FRAME (this));
int face_id = XINT (XCDR (XCAR (tail)));
int face_id = XFIXNUM (XCDR (XCAR (tail)));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
/* Face THIS itself is also freed by the following call. */
@ -1399,7 +1399,7 @@ static void
set_fontset_font (Lisp_Object arg, Lisp_Object range)
{
Lisp_Object fontset, font_def, add, ascii, script_range_list;
int from = XINT (XCAR (range)), to = XINT (XCDR (range));
int from = XFIXNUM (XCAR (range)), to = XFIXNUM (XCDR (range));
fontset = AREF (arg, 0);
font_def = AREF (arg, 1);
@ -1412,11 +1412,11 @@ set_fontset_font (Lisp_Object arg, Lisp_Object range)
if (to < 0x80)
return;
from = 0x80;
range = Fcons (make_number (0x80), XCDR (range));
range = Fcons (make_fixnum (0x80), XCDR (range));
}
#define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
#define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
#define SCRIPT_FROM XFIXNUM (XCAR (XCAR (script_range_list)))
#define SCRIPT_TO XFIXNUM (XCDR (XCAR (script_range_list)))
#define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
@ -1424,11 +1424,11 @@ set_fontset_font (Lisp_Object arg, Lisp_Object range)
if (CONSP (script_range_list))
{
if (SCRIPT_FROM < from)
range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
range = Fcons (make_fixnum (SCRIPT_FROM), XCDR (range));
while (CONSP (script_range_list) && SCRIPT_TO <= to)
POP_SCRIPT_RANGE ();
if (CONSP (script_range_list) && SCRIPT_FROM <= to)
XSETCAR (XCAR (script_range_list), make_number (to + 1));
XSETCAR (XCAR (script_range_list), make_fixnum (to + 1));
}
FONTSET_ADD (fontset, range, font_def, add);
@ -1442,23 +1442,26 @@ DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
doc: /*
Modify fontset NAME to use FONT-SPEC for TARGET characters.
NAME is a fontset name string, nil for the fontset of FRAME, or t for
the default fontset.
NAME is a fontset name (a string), nil for the fontset of FRAME,
or t for the default fontset.
TARGET may be a single character to use FONT-SPEC for.
Target may be a cons (FROM . TO), where FROM and TO are characters.
In that case, use FONT-SPEC for all characters in the range FROM
and TO (inclusive).
In that case, use FONT-SPEC for all the characters in the range
between FROM and TO (inclusive).
TARGET may be a script name symbol. In that case, use FONT-SPEC for
all characters that belong to the script.
TARGET may be a script symbol. In that case, use FONT-SPEC for
all the characters that belong to the script. See the variable
`script-representative-chars' for the list of known scripts.
TARGET may be a charset. In that case, use FONT-SPEC for all
characters in the charset.
the characters in the charset. See `list-character-sets' and
`list-charset-chars' for the list of character sets and their
characters.
TARGET may be nil. In that case, use FONT-SPEC for any characters for
that no FONT-SPEC is specified.
TARGET may be nil. In that case, use FONT-SPEC for any character for
which no font-spec is specified.
FONT-SPEC may one of these:
* A font-spec object made by the function `font-spec' (which see).
@ -1468,11 +1471,11 @@ FONT-SPEC may one of these:
* A font name string.
* nil, which explicitly specifies that there's no font for TARGET.
Optional 4th argument FRAME is a frame or nil for the selected frame
that is concerned in the case that NAME is nil.
Optional 4th argument FRAME is a frame, or nil for the selected frame,
to be considered in the case that NAME is nil.
Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
to the font specifications for TARGET previously set. If it is
to the previously set font specifications for TARGET. If it is
`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
appended. By default, FONT-SPEC overrides the previous settings. */)
(Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
@ -1544,7 +1547,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (CHARACTERP (target))
{
if (XFASTINT (target) < 0x80)
if (XFIXNAT (target) < 0x80)
error ("Can't set a font for partial ASCII range");
range_list = list1 (Fcons (target, target));
}
@ -1556,9 +1559,9 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
to = Fcdr (target);
CHECK_CHARACTER (from);
CHECK_CHARACTER (to);
if (XFASTINT (from) < 0x80)
if (XFIXNAT (from) < 0x80)
{
if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
if (XFIXNAT (from) != 0 || XFIXNAT (to) < 0x7F)
error ("Can't set a font for partial ASCII range");
ascii_changed = 1;
}
@ -1629,7 +1632,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
if (ascii_changed)
{
Lisp_Object tail, fr;
int fontset_id = XINT (FONTSET_ID (fontset));
int fontset_id = XFIXNUM (FONTSET_ID (fontset));
set_fontset_ascii (fontset, fontname);
name = FONTSET_NAME (fontset);
@ -1762,7 +1765,7 @@ fontset_from_font (Lisp_Object font_object)
val = assoc_no_quit (font_spec, auto_fontset_alist);
if (CONSP (val))
return XINT (FONTSET_ID (XCDR (val)));
return XFIXNUM (FONTSET_ID (XCDR (val)));
if (num_auto_fontsets++ == 0)
alias = intern ("fontset-startup");
else
@ -1797,7 +1800,7 @@ fontset_from_font (Lisp_Object font_object)
set_fontset_ascii (fontset, font_name);
return XINT (FONTSET_ID (fontset));
return XFIXNUM (FONTSET_ID (fontset));
}
@ -1985,7 +1988,7 @@ patterns. */)
fontset = check_fontset_name (name, &frame);
CHECK_CHARACTER (ch);
c = XINT (ch);
c = XFIXNUM (ch);
list = Qnil;
while (1)
{
@ -2000,9 +2003,9 @@ patterns. */)
if (NILP (val))
return Qnil;
repertory = AREF (val, 1);
if (INTEGERP (repertory))
if (FIXNUMP (repertory))
{
struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
struct charset *charset = CHARSET_FROM_ID (XFIXNUM (repertory));
if (! CHAR_CHARSET_P (c, charset))
continue;
@ -2061,7 +2064,7 @@ dump_fontset (Lisp_Object fontset)
{
Lisp_Object vec;
vec = Fmake_vector (make_number (3), Qnil);
vec = Fmake_vector (make_fixnum (3), Qnil);
ASET (vec, 0, FONTSET_ID (fontset));
if (BASE_FONTSET_P (fontset))
@ -2109,9 +2112,9 @@ void
syms_of_fontset (void)
{
DEFSYM (Qfontset, "fontset");
Fput (Qfontset, Qchar_table_extra_slots, make_number (8));
Fput (Qfontset, Qchar_table_extra_slots, make_fixnum (8));
DEFSYM (Qfontset_info, "fontset-info");
Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
Fput (Qfontset_info, Qchar_table_extra_slots, make_fixnum (1));
DEFSYM (Qappend, "append");
DEFSYM (Qlatin, "latin");
@ -2119,12 +2122,12 @@ syms_of_fontset (void)
Vcached_fontset_data = Qnil;
staticpro (&Vcached_fontset_data);
Vfontset_table = Fmake_vector (make_number (32), Qnil);
Vfontset_table = Fmake_vector (make_fixnum (32), Qnil);
staticpro (&Vfontset_table);
Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
staticpro (&Vdefault_fontset);
set_fontset_id (Vdefault_fontset, make_number (0));
set_fontset_id (Vdefault_fontset, make_fixnum (0));
set_fontset_name
(Vdefault_fontset,
build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));

366
src/frame.c
View file

@ -153,17 +153,17 @@ frame_size_history_add (struct frame *f, Lisp_Object fun_symbol,
XSETFRAME (frame, f);
if (CONSP (frame_size_history)
&& INTEGERP (XCAR (frame_size_history))
&& 0 < XINT (XCAR (frame_size_history)))
&& FIXNUMP (XCAR (frame_size_history))
&& 0 < XFIXNUM (XCAR (frame_size_history)))
frame_size_history =
Fcons (make_number (XINT (XCAR (frame_size_history)) - 1),
Fcons (make_fixnum (XFIXNUM (XCAR (frame_size_history)) - 1),
Fcons (list4
(frame, fun_symbol,
((width > 0)
? list4 (make_number (FRAME_TEXT_WIDTH (f)),
make_number (FRAME_TEXT_HEIGHT (f)),
make_number (width),
make_number (height))
? list4 (make_fixnum (FRAME_TEXT_WIDTH (f)),
make_fixnum (FRAME_TEXT_HEIGHT (f)),
make_fixnum (width),
make_fixnum (height))
: Qnil),
rest),
XCDR (frame_size_history)));
@ -214,8 +214,8 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval)
if (FRAME_MINIBUF_ONLY_P (f))
return;
if (TYPE_RANGED_INTEGERP (int, value))
nlines = XINT (value);
if (TYPE_RANGED_FIXNUMP (int, value))
nlines = XFIXNUM (value);
else
nlines = 0;
@ -317,7 +317,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
(Lisp_Object frame, Lisp_Object horizontal,
Lisp_Object ignore, Lisp_Object pixelwise)
{
return make_number (0);
return make_fixnum (0);
}
/**
@ -350,11 +350,11 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
int retval;
if ((!NILP (horizontal)
&& NUMBERP (par_size = get_frame_param (f, Qmin_width)))
&& FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_width)))
|| (NILP (horizontal)
&& NUMBERP (par_size = get_frame_param (f, Qmin_height))))
&& FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_height))))
{
int min_size = XINT (par_size);
int min_size = XFIXNUM (par_size);
/* Don't allow phantom frames. */
if (min_size < 1)
@ -367,7 +367,7 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
: FRAME_COLUMN_WIDTH (f)));
}
else
retval = XINT (call4 (Qframe_windows_min_size, frame, horizontal,
retval = XFIXNUM (call4 (Qframe_windows_min_size, frame, horizontal,
ignore, pixelwise));
/* Don't allow too small height of text-mode frames, or else cm.c
might abort in cmcheckmagic. */
@ -591,7 +591,7 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
frame_size_history_add
(f, Qadjust_frame_size_1, new_text_width, new_text_height,
list2 (parameter, make_number (inhibit)));
list2 (parameter, make_fixnum (inhibit)));
/* The following two values are calculated from the old window body
sizes and any "new" settings for scroll bars, dividers, fringes and
@ -737,8 +737,8 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
frame_size_history_add
(f, Qadjust_frame_size_3, new_text_width, new_text_height,
list4 (make_number (old_pixel_width), make_number (old_pixel_height),
make_number (new_pixel_width), make_number (new_pixel_height)));
list4 (make_fixnum (old_pixel_width), make_fixnum (old_pixel_height),
make_fixnum (new_pixel_width), make_fixnum (new_pixel_height)));
/* Assign new sizes. */
FRAME_TEXT_WIDTH (f) = new_text_width;
@ -1075,7 +1075,7 @@ make_initial_frame (void)
#endif
/* The default value of menu-bar-mode is t. */
set_menu_bar_lines (f, make_number (1), Qnil);
set_menu_bar_lines (f, make_fixnum (1), Qnil);
/* Allocate glyph matrices. */
adjust_frame_glyphs (f);
@ -1593,7 +1593,7 @@ candidate_frame (Lisp_Object candidate, Lisp_Object frame, Lisp_Object minibuf)
FRAME_FOCUS_FRAME (c)))
return candidate;
}
else if (INTEGERP (minibuf) && XINT (minibuf) == 0)
else if (FIXNUMP (minibuf) && XFIXNUM (minibuf) == 0)
{
if (FRAME_VISIBLE_P (c) || FRAME_ICONIFIED_P (c))
return candidate;
@ -1785,7 +1785,7 @@ check_minibuf_window (Lisp_Object frame, int select)
if (WINDOWP (minibuf_window) && EQ (f->minibuffer_window, minibuf_window))
{
Lisp_Object frames, this, window = make_number (0);
Lisp_Object frames, this, window = make_fixnum (0);
if (!EQ (frame, selected_frame)
&& FRAME_HAS_MINIBUF_P (XFRAME (selected_frame)))
@ -2315,8 +2315,8 @@ and returns whatever that function returns. */)
if (! NILP (x))
{
int col = XINT (x);
int row = XINT (y);
int col = XFIXNUM (x);
int row = XFIXNUM (y);
pixel_to_glyph_coords (f, col, row, &col, &row, NULL, 1);
XSETINT (x, col);
XSETINT (y, row);
@ -2425,19 +2425,19 @@ before calling this function on it, like this.
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
frame_set_mouse_position (XFRAME (frame), XINT (x), XINT (y));
frame_set_mouse_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
#else
#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (XINT (x), XINT (y));
mouse_moveto (XFIXNUM (x), XFIXNUM (y));
}
#else
#ifdef HAVE_GPM
{
Fselect_frame (frame, Qnil);
term_mouse_moveto (XINT (x), XINT (y));
term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
}
#endif
#endif
@ -2466,19 +2466,19 @@ before calling this function on it, like this.
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (XFRAME (frame)))
/* Warping the mouse will cause enternotify and focus events. */
frame_set_mouse_pixel_position (XFRAME (frame), XINT (x), XINT (y));
frame_set_mouse_pixel_position (XFRAME (frame), XFIXNUM (x), XFIXNUM (y));
#else
#if defined (MSDOS)
if (FRAME_MSDOS_P (XFRAME (frame)))
{
Fselect_frame (frame, Qnil);
mouse_moveto (XINT (x), XINT (y));
mouse_moveto (XFIXNUM (x), XFIXNUM (y));
}
#else
#ifdef HAVE_GPM
{
Fselect_frame (frame, Qnil);
term_mouse_moveto (XINT (x), XINT (y));
term_mouse_moveto (XFIXNUM (x), XFIXNUM (y));
}
#endif
#endif
@ -2982,7 +2982,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val)
if (! FRAME_WINDOW_P (f))
{
if (EQ (prop, Qmenu_bar_lines))
set_menu_bar_lines (f, val, make_number (FRAME_MENU_BAR_LINES (f)));
set_menu_bar_lines (f, val, make_fixnum (FRAME_MENU_BAR_LINES (f)));
else if (EQ (prop, Qname))
set_term_frame_name (f, val);
}
@ -3055,13 +3055,13 @@ If FRAME is omitted or nil, return information on the currently selected frame.
? (f->new_height / FRAME_LINE_HEIGHT (f))
: f->new_height)
: FRAME_LINES (f));
store_in_alist (&alist, Qheight, make_number (height));
store_in_alist (&alist, Qheight, make_fixnum (height));
width = (f->new_width
? (f->new_pixelwise
? (f->new_width / FRAME_COLUMN_WIDTH (f))
: f->new_width)
: FRAME_COLS (f));
store_in_alist (&alist, Qwidth, make_number (width));
store_in_alist (&alist, Qwidth, make_fixnum (width));
store_in_alist (&alist, Qmodeline, (FRAME_WANTS_MODELINE_P (f) ? Qt : Qnil));
store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil));
store_in_alist (&alist, Qbuffer_list, f->buffer_list);
@ -3113,7 +3113,7 @@ If FRAME is nil, describe the currently selected frame. */)
else if (EQ (parameter, Qline_spacing) && f->extra_line_spacing == 0)
/* If this is non-zero, we can't determine whether the user specified
an integer or float value without looking through 'param_alist'. */
value = make_number (0);
value = make_fixnum (0);
else if (EQ (parameter, Qfont) && FRAME_X_P (f))
value = FRAME_FONT (f)->props[FONT_NAME_INDEX];
#endif /* HAVE_WINDOW_SYSTEM */
@ -3186,7 +3186,7 @@ list, but are otherwise ignored. */)
#endif
{
EMACS_INT length = XFASTINT (Flength (alist));
EMACS_INT length = XFIXNAT (Flength (alist));
ptrdiff_t i;
Lisp_Object *parms;
Lisp_Object *values;
@ -3234,10 +3234,10 @@ For a terminal frame, the value is always 1. */)
struct frame *f = decode_any_frame (frame);
if (FRAME_WINDOW_P (f))
return make_number (FRAME_LINE_HEIGHT (f));
return make_fixnum (FRAME_LINE_HEIGHT (f));
else
#endif
return make_number (1);
return make_fixnum (1);
}
@ -3253,10 +3253,10 @@ For a terminal screen, the value is always 1. */)
struct frame *f = decode_any_frame (frame);
if (FRAME_WINDOW_P (f))
return make_number (FRAME_COLUMN_WIDTH (f));
return make_fixnum (FRAME_COLUMN_WIDTH (f));
else
#endif
return make_number (1);
return make_fixnum (1);
}
DEFUN ("frame-native-width", Fframe_native_width,
@ -3270,10 +3270,10 @@ If FRAME is omitted or nil, the selected frame is used. */)
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
return make_number (FRAME_PIXEL_WIDTH (f));
return make_fixnum (FRAME_PIXEL_WIDTH (f));
else
#endif
return make_number (FRAME_TOTAL_COLS (f));
return make_fixnum (FRAME_TOTAL_COLS (f));
}
DEFUN ("frame-native-height", Fframe_native_height,
@ -3296,10 +3296,10 @@ to `frame-height'). */)
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
return make_number (FRAME_PIXEL_HEIGHT (f));
return make_fixnum (FRAME_PIXEL_HEIGHT (f));
else
#endif
return make_number (FRAME_TOTAL_LINES (f));
return make_fixnum (FRAME_TOTAL_LINES (f));
}
DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
@ -3314,93 +3314,93 @@ is used. */)
struct frame *f = decode_any_frame (frame);
if (FRAME_WINDOW_P (f))
return make_number (FRAME_TOOLBAR_WIDTH (f));
return make_fixnum (FRAME_TOOLBAR_WIDTH (f));
#endif
return make_number (0);
return make_fixnum (0);
}
DEFUN ("frame-text-cols", Fframe_text_cols, Sframe_text_cols, 0, 1, 0,
doc: /* Return width in columns of FRAME's text area. */)
(Lisp_Object frame)
{
return make_number (FRAME_COLS (decode_any_frame (frame)));
return make_fixnum (FRAME_COLS (decode_any_frame (frame)));
}
DEFUN ("frame-text-lines", Fframe_text_lines, Sframe_text_lines, 0, 1, 0,
doc: /* Return height in lines of FRAME's text area. */)
(Lisp_Object frame)
{
return make_number (FRAME_LINES (decode_any_frame (frame)));
return make_fixnum (FRAME_LINES (decode_any_frame (frame)));
}
DEFUN ("frame-total-cols", Fframe_total_cols, Sframe_total_cols, 0, 1, 0,
doc: /* Return number of total columns of FRAME. */)
(Lisp_Object frame)
{
return make_number (FRAME_TOTAL_COLS (decode_any_frame (frame)));
return make_fixnum (FRAME_TOTAL_COLS (decode_any_frame (frame)));
}
DEFUN ("frame-total-lines", Fframe_total_lines, Sframe_total_lines, 0, 1, 0,
doc: /* Return number of total lines of FRAME. */)
(Lisp_Object frame)
{
return make_number (FRAME_TOTAL_LINES (decode_any_frame (frame)));
return make_fixnum (FRAME_TOTAL_LINES (decode_any_frame (frame)));
}
DEFUN ("frame-text-width", Fframe_text_width, Sframe_text_width, 0, 1, 0,
doc: /* Return text area width of FRAME in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_TEXT_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_TEXT_WIDTH (decode_any_frame (frame)));
}
DEFUN ("frame-text-height", Fframe_text_height, Sframe_text_height, 0, 1, 0,
doc: /* Return text area height of FRAME in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_TEXT_HEIGHT (decode_any_frame (frame)));
return make_fixnum (FRAME_TEXT_HEIGHT (decode_any_frame (frame)));
}
DEFUN ("frame-scroll-bar-width", Fscroll_bar_width, Sscroll_bar_width, 0, 1, 0,
doc: /* Return scroll bar width of FRAME in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_SCROLL_BAR_AREA_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_SCROLL_BAR_AREA_WIDTH (decode_any_frame (frame)));
}
DEFUN ("frame-scroll-bar-height", Fscroll_bar_height, Sscroll_bar_height, 0, 1, 0,
doc: /* Return scroll bar height of FRAME in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_SCROLL_BAR_AREA_HEIGHT (decode_any_frame (frame)));
return make_fixnum (FRAME_SCROLL_BAR_AREA_HEIGHT (decode_any_frame (frame)));
}
DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
doc: /* Return fringe width of FRAME in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
}
DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0,
doc: /* Return width of FRAME's internal border in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
}
DEFUN ("frame-right-divider-width", Fright_divider_width, Sright_divider_width, 0, 1, 0,
doc: /* Return width (in pixels) of vertical window dividers on FRAME. */)
(Lisp_Object frame)
{
return make_number (FRAME_RIGHT_DIVIDER_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_RIGHT_DIVIDER_WIDTH (decode_any_frame (frame)));
}
DEFUN ("frame-bottom-divider-width", Fbottom_divider_width, Sbottom_divider_width, 0, 1, 0,
doc: /* Return width (in pixels) of horizontal window dividers on FRAME. */)
(Lisp_Object frame)
{
return make_number (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame)));
return make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (decode_any_frame (frame)));
}
DEFUN ("set-frame-height", Fset_frame_height, Sset_frame_height, 2, 4, 0,
@ -3421,8 +3421,8 @@ multiple of the default frame font height. */)
CHECK_TYPE_RANGED_INTEGER (int, height);
pixel_height = (!NILP (pixelwise)
? XINT (height)
: XINT (height) * FRAME_LINE_HEIGHT (f));
? XFIXNUM (height)
: XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
adjust_frame_size (f, -1, pixel_height, 1, !NILP (pretend), Qheight);
return Qnil;
@ -3446,8 +3446,8 @@ multiple of the default frame font width. */)
CHECK_TYPE_RANGED_INTEGER (int, width);
pixel_width = (!NILP (pixelwise)
? XINT (width)
: XINT (width) * FRAME_COLUMN_WIDTH (f));
? XFIXNUM (width)
: XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
adjust_frame_size (f, pixel_width, -1, 1, !NILP (pretend), Qwidth);
return Qnil;
@ -3469,11 +3469,11 @@ font height. */)
CHECK_TYPE_RANGED_INTEGER (int, height);
pixel_width = (!NILP (pixelwise)
? XINT (width)
: XINT (width) * FRAME_COLUMN_WIDTH (f));
? XFIXNUM (width)
: XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
pixel_height = (!NILP (pixelwise)
? XINT (height)
: XINT (height) * FRAME_LINE_HEIGHT (f));
? XFIXNUM (height)
: XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
adjust_frame_size (f, pixel_width, pixel_height, 1, 0, Qsize);
return Qnil;
@ -3490,7 +3490,7 @@ display. */)
{
register struct frame *f = decode_live_frame (frame);
return Fcons (make_number (f->left_pos), make_number (f->top_pos));
return Fcons (make_fixnum (f->left_pos), make_fixnum (f->top_pos));
}
DEFUN ("set-frame-position", Fset_frame_position,
@ -3513,7 +3513,7 @@ bottom edge of FRAME's display. */)
if (FRAME_WINDOW_P (f))
{
#ifdef HAVE_WINDOW_SYSTEM
x_set_offset (f, XINT (x), XINT (y), 1);
x_set_offset (f, XFIXNUM (x), XFIXNUM (y), 1);
#endif
}
@ -3682,10 +3682,10 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
}
/* Workarea available. */
parent_left = XINT (Fnth (make_number (0), workarea));
parent_top = XINT (Fnth (make_number (1), workarea));
parent_width = XINT (Fnth (make_number (2), workarea));
parent_height = XINT (Fnth (make_number (3), workarea));
parent_left = XFIXNUM (Fnth (make_fixnum (0), workarea));
parent_top = XFIXNUM (Fnth (make_fixnum (1), workarea));
parent_width = XFIXNUM (Fnth (make_fixnum (2), workarea));
parent_height = XFIXNUM (Fnth (make_fixnum (3), workarea));
*parent_done = 1;
}
}
@ -3713,12 +3713,12 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
if (!NILP (outer_edges))
{
outer_minus_text_width
= (XINT (Fnth (make_number (2), outer_edges))
- XINT (Fnth (make_number (0), outer_edges))
= (XFIXNUM (Fnth (make_fixnum (2), outer_edges))
- XFIXNUM (Fnth (make_fixnum (0), outer_edges))
- FRAME_TEXT_WIDTH (f));
outer_minus_text_height
= (XINT (Fnth (make_number (3), outer_edges))
- XINT (Fnth (make_number (1), outer_edges))
= (XFIXNUM (Fnth (make_fixnum (3), outer_edges))
- XFIXNUM (Fnth (make_fixnum (1), outer_edges))
- FRAME_TEXT_HEIGHT (f));
}
else
@ -3798,7 +3798,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
Lisp_Object icon_left, icon_top;
/* And with this. */
Lisp_Object fullscreen;
Lisp_Object fullscreen UNINIT;
bool fullscreen_change = false;
/* Record in these vectors all the parms specified. */
@ -3867,22 +3867,22 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
if (EQ (prop, Qwidth))
{
if (RANGED_INTEGERP (0, val, INT_MAX))
width = XFASTINT (val) * FRAME_COLUMN_WIDTH (f) ;
if (RANGED_FIXNUMP (0, val, INT_MAX))
width = XFIXNAT (val) * FRAME_COLUMN_WIDTH (f) ;
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
width = XFASTINT (XCDR (val));
&& RANGED_FIXNUMP (0, XCDR (val), INT_MAX))
width = XFIXNAT (XCDR (val));
else if (FLOATP (val))
width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done,
&outer_done, -1);
}
else if (EQ (prop, Qheight))
{
if (RANGED_INTEGERP (0, val, INT_MAX))
height = XFASTINT (val) * FRAME_LINE_HEIGHT (f);
if (RANGED_FIXNUMP (0, val, INT_MAX))
height = XFIXNAT (val) * FRAME_LINE_HEIGHT (f);
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
height = XFASTINT (XCDR (val));
&& RANGED_FIXNUMP (0, XCDR (val), INT_MAX))
height = XFIXNAT (XCDR (val));
else if (FLOATP (val))
height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done,
&outer_done, -1);
@ -3909,10 +3909,10 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
store_frame_param (f, prop, val);
param_index = Fget (prop, Qx_frame_parameter);
if (NATNUMP (param_index)
&& XFASTINT (param_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])
(*(FRAME_RIF (f)->frame_parm_handlers[XINT (param_index)])) (f, val, old_value);
if (FIXNATP (param_index)
&& XFIXNAT (param_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])
(*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f, val, old_value);
}
}
@ -3921,7 +3921,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
left_no_change = 1;
if (f->left_pos < 0)
left = list2 (Qplus, make_number (f->left_pos));
left = list2 (Qplus, make_fixnum (f->left_pos));
else
XSETINT (left, f->left_pos);
}
@ -3929,13 +3929,13 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
top_no_change = 1;
if (f->top_pos < 0)
top = list2 (Qplus, make_number (f->top_pos));
top = list2 (Qplus, make_fixnum (f->top_pos));
else
XSETINT (top, f->top_pos);
}
/* If one of the icon positions was not set, preserve or default it. */
if (! TYPE_RANGED_INTEGERP (int, icon_left))
if (! TYPE_RANGED_FIXNUMP (int, icon_left))
{
#ifdef HAVE_X_WINDOWS
icon_left_no_change = 1;
@ -3944,7 +3944,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
if (NILP (icon_left))
XSETINT (icon_left, 0);
}
if (! TYPE_RANGED_INTEGERP (int, icon_top))
if (! TYPE_RANGED_FIXNUMP (int, icon_top))
{
#ifdef HAVE_X_WINDOWS
icon_top_no_change = 1;
@ -3974,8 +3974,8 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
if ((!NILP (left) || !NILP (top))
&& ! (left_no_change && top_no_change)
&& ! (NUMBERP (left) && XINT (left) == f->left_pos
&& NUMBERP (top) && XINT (top) == f->top_pos))
&& ! (FIXED_OR_FLOATP (left) && XFIXNUM (left) == f->left_pos
&& FIXED_OR_FLOATP (top) && XFIXNUM (top) == f->top_pos))
{
int leftpos = 0;
int toppos = 0;
@ -3984,46 +3984,46 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
f->size_hint_flags &= ~ (XNegative | YNegative);
if (EQ (left, Qminus))
f->size_hint_flags |= XNegative;
else if (TYPE_RANGED_INTEGERP (int, left))
else if (TYPE_RANGED_FIXNUMP (int, left))
{
leftpos = XINT (left);
leftpos = XFIXNUM (left);
if (leftpos < 0)
f->size_hint_flags |= XNegative;
}
else if (CONSP (left) && EQ (XCAR (left), Qminus)
&& CONSP (XCDR (left))
&& RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
&& RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
{
leftpos = - XINT (XCAR (XCDR (left)));
leftpos = - XFIXNUM (XCAR (XCDR (left)));
f->size_hint_flags |= XNegative;
}
else if (CONSP (left) && EQ (XCAR (left), Qplus)
&& CONSP (XCDR (left))
&& TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
leftpos = XINT (XCAR (XCDR (left)));
&& TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left))))
leftpos = XFIXNUM (XCAR (XCDR (left)));
else if (FLOATP (left))
leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
&outer_done, 0);
if (EQ (top, Qminus))
f->size_hint_flags |= YNegative;
else if (TYPE_RANGED_INTEGERP (int, top))
else if (TYPE_RANGED_FIXNUMP (int, top))
{
toppos = XINT (top);
toppos = XFIXNUM (top);
if (toppos < 0)
f->size_hint_flags |= YNegative;
}
else if (CONSP (top) && EQ (XCAR (top), Qminus)
&& CONSP (XCDR (top))
&& RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
&& RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
{
toppos = - XINT (XCAR (XCDR (top)));
toppos = - XFIXNUM (XCAR (XCDR (top)));
f->size_hint_flags |= YNegative;
}
else if (CONSP (top) && EQ (XCAR (top), Qplus)
&& CONSP (XCDR (top))
&& TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
toppos = XINT (XCAR (XCDR (top)));
&& TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top))))
toppos = XFIXNUM (XCAR (XCDR (top)));
else if (FLOATP (top))
toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
&outer_done, 0);
@ -4054,7 +4054,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
#ifdef HAVE_X_WINDOWS
if ((!NILP (icon_left) || !NILP (icon_top))
&& ! (icon_left_no_change && icon_top_no_change))
x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
x_wm_set_icon_position (f, XFIXNUM (icon_left), XFIXNUM (icon_top));
#endif /* HAVE_X_WINDOWS */
SAFE_FREE ();
@ -4089,31 +4089,31 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
store_in_alist (alistptr, Qtop, list2 (Qplus, tem));
store_in_alist (alistptr, Qborder_width,
make_number (f->border_width));
make_fixnum (f->border_width));
store_in_alist (alistptr, Qinternal_border_width,
make_number (FRAME_INTERNAL_BORDER_WIDTH (f)));
make_fixnum (FRAME_INTERNAL_BORDER_WIDTH (f)));
store_in_alist (alistptr, Qright_divider_width,
make_number (FRAME_RIGHT_DIVIDER_WIDTH (f)));
make_fixnum (FRAME_RIGHT_DIVIDER_WIDTH (f)));
store_in_alist (alistptr, Qbottom_divider_width,
make_number (FRAME_BOTTOM_DIVIDER_WIDTH (f)));
make_fixnum (FRAME_BOTTOM_DIVIDER_WIDTH (f)));
store_in_alist (alistptr, Qleft_fringe,
make_number (FRAME_LEFT_FRINGE_WIDTH (f)));
make_fixnum (FRAME_LEFT_FRINGE_WIDTH (f)));
store_in_alist (alistptr, Qright_fringe,
make_number (FRAME_RIGHT_FRINGE_WIDTH (f)));
make_fixnum (FRAME_RIGHT_FRINGE_WIDTH (f)));
store_in_alist (alistptr, Qscroll_bar_width,
(! FRAME_HAS_VERTICAL_SCROLL_BARS (f)
? make_number (0)
? make_fixnum (0)
: FRAME_CONFIG_SCROLL_BAR_WIDTH (f) > 0
? make_number (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
? make_fixnum (FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
/* nil means "use default width"
for non-toolkit scroll bar.
ruler-mode.el depends on this. */
: Qnil));
store_in_alist (alistptr, Qscroll_bar_height,
(! FRAME_HAS_HORIZONTAL_SCROLL_BARS (f)
? make_number (0)
? make_fixnum (0)
: FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) > 0
? make_number (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f))
? make_fixnum (FRAME_CONFIG_SCROLL_BAR_HEIGHT (f))
/* nil means "use default height"
for non-toolkit scroll bar. */
: Qnil));
@ -4143,7 +4143,7 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr)
if (FRAME_X_OUTPUT (f)->parent_desc == FRAME_DISPLAY_INFO (f)->root_window)
tem = Qnil;
else
tem = make_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
tem = make_fixed_natnum ((uintptr_t) FRAME_X_OUTPUT (f)->parent_desc);
store_in_alist (alistptr, Qexplicit_name, (f->explicit_name ? Qt : Qnil));
store_in_alist (alistptr, Qparent_id, tem);
store_in_alist (alistptr, Qtool_bar_position, FRAME_TOOL_BAR_POSITION (f));
@ -4180,8 +4180,8 @@ x_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
{
if (NILP (new_value))
f->extra_line_spacing = 0;
else if (RANGED_INTEGERP (0, new_value, INT_MAX))
f->extra_line_spacing = XFASTINT (new_value);
else if (RANGED_FIXNUMP (0, new_value, INT_MAX))
f->extra_line_spacing = XFIXNAT (new_value);
else if (FLOATP (new_value))
{
int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5;
@ -4208,7 +4208,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
if (NILP (new_value))
f->gamma = 0;
else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
else if (FIXED_OR_FLOATP (new_value) && XFLOATINT (new_value) > 0)
/* The value 0.4545 is the normal viewing gamma. */
f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
else
@ -4219,10 +4219,10 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor)))
{
Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter);
if (NATNUMP (parm_index)
&& XFASTINT (parm_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
(*FRAME_RIF (f)->frame_parm_handlers[XFASTINT (parm_index)])
if (FIXNATP (parm_index)
&& XFIXNAT (parm_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)])
(*FRAME_RIF (f)->frame_parm_handlers[XFIXNAT (parm_index)])
(f, bgcolor, Qnil);
}
@ -4407,8 +4407,8 @@ x_set_left_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_value
int old_width = FRAME_LEFT_FRINGE_WIDTH (f);
int new_width;
new_width = (RANGED_INTEGERP (-INT_MAX, new_value, INT_MAX)
? eabs (XINT (new_value)) : 8);
new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX)
? eabs (XFIXNUM (new_value)) : 8);
if (new_width != old_width)
{
@ -4431,8 +4431,8 @@ x_set_right_fringe (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu
int old_width = FRAME_RIGHT_FRINGE_WIDTH (f);
int new_width;
new_width = (RANGED_INTEGERP (-INT_MAX, new_value, INT_MAX)
? eabs (XINT (new_value)) : 8);
new_width = (RANGED_FIXNUMP (-INT_MAX, new_value, INT_MAX)
? eabs (XFIXNUM (new_value)) : 8);
if (new_width != old_width)
{
@ -4453,13 +4453,13 @@ x_set_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
CHECK_TYPE_RANGED_INTEGER (int, arg);
if (XINT (arg) == f->border_width)
if (XFIXNUM (arg) == f->border_width)
return;
if (FRAME_X_WINDOW (f) != 0)
error ("Cannot change the border width of a frame");
f->border_width = XINT (arg);
f->border_width = XFIXNUM (arg);
}
void
@ -4467,7 +4467,7 @@ x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
{
int old = FRAME_RIGHT_DIVIDER_WIDTH (f);
CHECK_TYPE_RANGED_INTEGER (int, arg);
int new = max (0, XINT (arg));
int new = max (0, XFIXNUM (arg));
if (new != old)
{
f->right_divider_width = new;
@ -4482,7 +4482,7 @@ x_set_bottom_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval
{
int old = FRAME_BOTTOM_DIVIDER_WIDTH (f);
CHECK_TYPE_RANGED_INTEGER (int, arg);
int new = max (0, XINT (arg));
int new = max (0, XFIXNUM (arg));
if (new != old)
{
f->bottom_divider_width = new;
@ -4591,11 +4591,11 @@ x_set_scroll_bar_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
SET_FRAME_GARBAGED (f);
}
else if (RANGED_INTEGERP (1, arg, INT_MAX)
&& XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
else if (RANGED_FIXNUMP (1, arg, INT_MAX)
&& XFIXNAT (arg) != FRAME_CONFIG_SCROLL_BAR_WIDTH (f))
{
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFASTINT (arg);
FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFASTINT (arg) + unit - 1) / unit;
FRAME_CONFIG_SCROLL_BAR_WIDTH (f) = XFIXNAT (arg);
FRAME_CONFIG_SCROLL_BAR_COLS (f) = (XFIXNAT (arg) + unit - 1) / unit;
if (FRAME_X_WINDOW (f))
adjust_frame_size (f, -1, -1, 3, 0, Qscroll_bar_width);
@ -4621,11 +4621,11 @@ x_set_scroll_bar_height (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
SET_FRAME_GARBAGED (f);
}
else if (RANGED_INTEGERP (1, arg, INT_MAX)
&& XFASTINT (arg) != FRAME_CONFIG_SCROLL_BAR_HEIGHT (f))
else if (RANGED_FIXNUMP (1, arg, INT_MAX)
&& XFIXNAT (arg) != FRAME_CONFIG_SCROLL_BAR_HEIGHT (f))
{
FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = XFASTINT (arg);
FRAME_CONFIG_SCROLL_BAR_LINES (f) = (XFASTINT (arg) + unit - 1) / unit;
FRAME_CONFIG_SCROLL_BAR_HEIGHT (f) = XFIXNAT (arg);
FRAME_CONFIG_SCROLL_BAR_LINES (f) = (XFIXNAT (arg) + unit - 1) / unit;
if (FRAME_X_WINDOW (f))
adjust_frame_size (f, -1, -1, 3, 0, Qscroll_bar_height);
@ -4664,11 +4664,11 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
if (! (0 <= alpha && alpha <= 1.0))
args_out_of_range (make_float (0.0), make_float (1.0));
}
else if (INTEGERP (item))
else if (FIXNUMP (item))
{
EMACS_INT ialpha = XINT (item);
EMACS_INT ialpha = XFIXNUM (item);
if (! (0 <= ialpha && ialpha <= 100))
args_out_of_range (make_number (0), make_number (100));
args_out_of_range (make_fixnum (0), make_fixnum (100));
alpha = ialpha / 100.0;
}
else
@ -4980,13 +4980,13 @@ x_get_arg (Display_Info *dpyinfo, Lisp_Object alist, Lisp_Object param,
switch (type)
{
case RES_TYPE_NUMBER:
return make_number (atoi (SSDATA (tem)));
return make_fixnum (atoi (SSDATA (tem)));
case RES_TYPE_BOOLEAN_NUMBER:
if (!strcmp (SSDATA (tem), "on")
|| !strcmp (SSDATA (tem), "true"))
return make_number (1);
return make_number (atoi (SSDATA (tem)));
return make_fixnum (1);
return make_fixnum (atoi (SSDATA (tem)));
break;
case RES_TYPE_FLOAT:
@ -5215,11 +5215,11 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (x >= 0 && (geometry & XNegative))
element = list3 (Qleft, Qminus, make_number (-x));
element = list3 (Qleft, Qminus, make_fixnum (-x));
else if (x < 0 && ! (geometry & XNegative))
element = list3 (Qleft, Qplus, make_number (x));
element = list3 (Qleft, Qplus, make_fixnum (x));
else
element = Fcons (Qleft, make_number (x));
element = Fcons (Qleft, make_fixnum (x));
result = Fcons (element, result);
}
@ -5228,18 +5228,18 @@ On Nextstep, this just calls `ns-parse-geometry'. */)
Lisp_Object element;
if (y >= 0 && (geometry & YNegative))
element = list3 (Qtop, Qminus, make_number (-y));
element = list3 (Qtop, Qminus, make_fixnum (-y));
else if (y < 0 && ! (geometry & YNegative))
element = list3 (Qtop, Qplus, make_number (y));
element = list3 (Qtop, Qplus, make_fixnum (y));
else
element = Fcons (Qtop, make_number (y));
element = Fcons (Qtop, make_fixnum (y));
result = Fcons (element, result);
}
if (geometry & WidthValue)
result = Fcons (Fcons (Qwidth, make_number (width)), result);
result = Fcons (Fcons (Qwidth, make_fixnum (width)), result);
if (geometry & HeightValue)
result = Fcons (Fcons (Qheight, make_number (height)), result);
result = Fcons (Fcons (Qheight, make_fixnum (height)), result);
return result;
}
@ -5295,11 +5295,11 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
? tool_bar_button_relief
: DEFAULT_TOOL_BAR_BUTTON_RELIEF);
if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
margin = XFASTINT (Vtool_bar_button_margin);
if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX))
margin = XFIXNAT (Vtool_bar_button_margin);
else if (CONSP (Vtool_bar_button_margin)
&& RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
margin = XFASTINT (XCDR (Vtool_bar_button_margin));
&& RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
margin = XFIXNAT (XCDR (Vtool_bar_button_margin));
else
margin = 0;
@ -5320,13 +5320,13 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
{
if (CONSP (width) && EQ (XCAR (width), Qtext_pixels))
{
CHECK_NUMBER (XCDR (width));
if ((XINT (XCDR (width)) < 0 || XINT (XCDR (width)) > INT_MAX))
CHECK_FIXNUM (XCDR (width));
if ((XFIXNUM (XCDR (width)) < 0 || XFIXNUM (XCDR (width)) > INT_MAX))
xsignal1 (Qargs_out_of_range, XCDR (width));
SET_FRAME_WIDTH (f, XINT (XCDR (width)));
SET_FRAME_WIDTH (f, XFIXNUM (XCDR (width)));
f->inhibit_horizontal_resize = true;
*x_width = XINT (XCDR (width));
*x_width = XFIXNUM (XCDR (width));
}
else if (FLOATP (width))
{
@ -5345,11 +5345,11 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
}
else
{
CHECK_NUMBER (width);
if ((XINT (width) < 0 || XINT (width) > INT_MAX))
CHECK_FIXNUM (width);
if ((XFIXNUM (width) < 0 || XFIXNUM (width) > INT_MAX))
xsignal1 (Qargs_out_of_range, width);
SET_FRAME_WIDTH (f, XINT (width) * FRAME_COLUMN_WIDTH (f));
SET_FRAME_WIDTH (f, XFIXNUM (width) * FRAME_COLUMN_WIDTH (f));
}
}
@ -5357,13 +5357,13 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
{
if (CONSP (height) && EQ (XCAR (height), Qtext_pixels))
{
CHECK_NUMBER (XCDR (height));
if ((XINT (XCDR (height)) < 0 || XINT (XCDR (height)) > INT_MAX))
CHECK_FIXNUM (XCDR (height));
if ((XFIXNUM (XCDR (height)) < 0 || XFIXNUM (XCDR (height)) > INT_MAX))
xsignal1 (Qargs_out_of_range, XCDR (height));
SET_FRAME_HEIGHT (f, XINT (XCDR (height)));
SET_FRAME_HEIGHT (f, XFIXNUM (XCDR (height)));
f->inhibit_vertical_resize = true;
*x_height = XINT (XCDR (height));
*x_height = XFIXNUM (XCDR (height));
}
else if (FLOATP (height))
{
@ -5382,11 +5382,11 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
}
else
{
CHECK_NUMBER (height);
if ((XINT (height) < 0) || (XINT (height) > INT_MAX))
CHECK_FIXNUM (height);
if ((XFIXNUM (height) < 0) || (XFIXNUM (height) > INT_MAX))
xsignal1 (Qargs_out_of_range, height);
SET_FRAME_HEIGHT (f, XINT (height) * FRAME_LINE_HEIGHT (f));
SET_FRAME_HEIGHT (f, XFIXNUM (height) * FRAME_LINE_HEIGHT (f));
}
}
@ -5409,16 +5409,16 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
}
else if (CONSP (top) && EQ (XCAR (top), Qminus)
&& CONSP (XCDR (top))
&& RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
&& RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
{
f->top_pos = - XINT (XCAR (XCDR (top)));
f->top_pos = - XFIXNUM (XCAR (XCDR (top)));
window_prompting |= YNegative;
}
else if (CONSP (top) && EQ (XCAR (top), Qplus)
&& CONSP (XCDR (top))
&& TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
&& TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (top))))
{
f->top_pos = XINT (XCAR (XCDR (top)));
f->top_pos = XFIXNUM (XCAR (XCDR (top)));
}
else if (FLOATP (top))
f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
@ -5428,7 +5428,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
else
{
CHECK_TYPE_RANGED_INTEGER (int, top);
f->top_pos = XINT (top);
f->top_pos = XFIXNUM (top);
if (f->top_pos < 0)
window_prompting |= YNegative;
}
@ -5440,16 +5440,16 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
}
else if (CONSP (left) && EQ (XCAR (left), Qminus)
&& CONSP (XCDR (left))
&& RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
&& RANGED_FIXNUMP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
{
f->left_pos = - XINT (XCAR (XCDR (left)));
f->left_pos = - XFIXNUM (XCAR (XCDR (left)));
window_prompting |= XNegative;
}
else if (CONSP (left) && EQ (XCAR (left), Qplus)
&& CONSP (XCDR (left))
&& TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
&& TYPE_RANGED_FIXNUMP (int, XCAR (XCDR (left))))
{
f->left_pos = XINT (XCAR (XCDR (left)));
f->left_pos = XFIXNUM (XCAR (XCDR (left)));
}
else if (FLOATP (left))
f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
@ -5459,7 +5459,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
else
{
CHECK_TYPE_RANGED_INTEGER (int, left);
f->left_pos = XINT (left);
f->left_pos = XFIXNUM (left);
if (f->left_pos < 0)
window_prompting |= XNegative;
}
@ -5784,7 +5784,7 @@ syms_of_frame (void)
Lisp_Object v = (frame_parms[i].sym < 0
? intern_c_string (frame_parms[i].name)
: builtin_lisp_symbol (frame_parms[i].sym));
Fput (v, Qx_frame_parameter, make_number (i));
Fput (v, Qx_frame_parameter, make_fixnum (i));
}
}
@ -5817,7 +5817,7 @@ is a reasonable practice. See also the variable `x-resource-name'. */);
doc: /* The lower limit of the frame opacity (alpha transparency).
The value should range from 0 (invisible) to 100 (completely opaque).
You can also use a floating number between 0.0 and 1.0. */);
Vframe_alpha_lower_limit = make_number (20);
Vframe_alpha_lower_limit = make_fixnum (20);
#endif
DEFVAR_LISP ("default-frame-alist", Vdefault_frame_alist,

14
src/frame.h
View file

@ -699,7 +699,7 @@ fset_desired_tool_bar_string (struct frame *f, Lisp_Object val)
INLINE double
NUMVAL (Lisp_Object x)
{
return NUMBERP (x) ? XFLOATINT (x) : -1;
return FIXED_OR_FLOATP (x) ? XFLOATINT (x) : -1;
}
INLINE double
@ -1360,16 +1360,16 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
canonical char width is to be used. X must be a Lisp integer or
float. Value is a C integer. */
#define FRAME_PIXEL_X_FROM_CANON_X(F, X) \
(INTEGERP (X) \
? XINT (X) * FRAME_COLUMN_WIDTH (F) \
(FIXNUMP (X) \
? XFIXNUM (X) * FRAME_COLUMN_WIDTH (F) \
: (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F)))
/* Convert canonical value Y to pixels. F is the frame whose
canonical character height is to be used. X must be a Lisp integer
or float. Value is a C integer. */
#define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \
(INTEGERP (Y) \
? XINT (Y) * FRAME_LINE_HEIGHT (F) \
(FIXNUMP (Y) \
? XFIXNUM (Y) * FRAME_LINE_HEIGHT (F) \
: (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F)))
/* Convert pixel-value X to canonical units. F is the frame whose
@ -1379,7 +1379,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
#define FRAME_CANON_X_FROM_PIXEL_X(F, X) \
((X) % FRAME_COLUMN_WIDTH (F) != 0 \
? make_float ((double) (X) / FRAME_COLUMN_WIDTH (F)) \
: make_number ((X) / FRAME_COLUMN_WIDTH (F)))
: make_fixnum ((X) / FRAME_COLUMN_WIDTH (F)))
/* Convert pixel-value Y to canonical units. F is the frame whose
canonical character height is to be used. Y is a C integer.
@ -1388,7 +1388,7 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
#define FRAME_CANON_Y_FROM_PIXEL_Y(F, Y) \
((Y) % FRAME_LINE_HEIGHT (F) \
? make_float ((double) (Y) / FRAME_LINE_HEIGHT (F)) \
: make_number ((Y) / FRAME_LINE_HEIGHT (F)))
: make_fixnum ((Y) / FRAME_LINE_HEIGHT (F)))

40
src/fringe.c
View file

@ -488,10 +488,10 @@ lookup_fringe_bitmap (Lisp_Object bitmap)
EMACS_INT bn;
bitmap = Fget (bitmap, Qfringe);
if (!INTEGERP (bitmap))
if (!FIXNUMP (bitmap))
return 0;
bn = XINT (bitmap);
bn = XFIXNUM (bitmap);
if (bn > NO_FRINGE_BITMAP
&& bn < max_used_fringe_bitmap
&& (bn < MAX_STANDARD_FRINGE_BITMAPS
@ -519,7 +519,7 @@ get_fringe_bitmap_name (int bn)
return Qnil;
bitmaps = Vfringe_bitmaps;
num = make_number (bn);
num = make_fixnum (bn);
while (CONSP (bitmaps))
{
@ -743,12 +743,12 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
return NO_FRINGE_BITMAP;
if (CONSP (bm1))
{
ln1 = XINT (Flength (bm1));
ln1 = XFIXNUM (Flength (bm1));
if (partial_p)
{
if (ln1 > ix2)
{
bm = Fnth (make_number (ix2), bm1);
bm = Fnth (make_fixnum (ix2), bm1);
if (!EQ (bm, Qt))
goto found;
}
@ -757,7 +757,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
{
if (ln1 > ix1)
{
bm = Fnth (make_number (ix1), bm1);
bm = Fnth (make_fixnum (ix1), bm1);
if (!EQ (bm, Qt))
goto found;
}
@ -778,12 +778,12 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
{
if (CONSP (bm2))
{
ln2 = XINT (Flength (bm2));
ln2 = XFIXNUM (Flength (bm2));
if (partial_p)
{
if (ln2 > ix2)
{
bm = Fnth (make_number (ix2), bm2);
bm = Fnth (make_fixnum (ix2), bm2);
if (!EQ (bm, Qt))
goto found;
}
@ -795,14 +795,14 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in
if (ln1 > ix1)
{
bm = Fnth (make_number (ix1), bm1);
bm = Fnth (make_fixnum (ix1), bm1);
if (!EQ (bm, Qt))
goto found;
}
if (ln2 > ix1)
{
bm = Fnth (make_number (ix1), bm2);
bm = Fnth (make_fixnum (ix1), bm2);
if (!EQ (bm, Qt))
goto found;
return NO_FRINGE_BITMAP;
@ -1509,8 +1509,8 @@ If BITMAP already exists, the existing definition is replaced. */)
fb.height = h;
else
{
CHECK_NUMBER (height);
fb.height = max (0, min (XINT (height), 255));
CHECK_FIXNUM (height);
fb.height = max (0, min (XFIXNUM (height), 255));
if (fb.height > h)
{
fill1 = (fb.height - h) / 2;
@ -1522,8 +1522,8 @@ If BITMAP already exists, the existing definition is replaced. */)
fb.width = 8;
else
{
CHECK_NUMBER (width);
fb.width = max (0, min (XINT (width), 255));
CHECK_FIXNUM (width);
fb.width = max (0, min (XFIXNUM (width), 255));
}
fb.period = 0;
@ -1586,7 +1586,7 @@ If BITMAP already exists, the existing definition is replaced. */)
}
Vfringe_bitmaps = Fcons (bitmap, Vfringe_bitmaps);
Fput (bitmap, Qfringe, make_number (n));
Fput (bitmap, Qfringe, make_fixnum (n));
}
fb.dynamic = true;
@ -1604,8 +1604,8 @@ If BITMAP already exists, the existing definition is replaced. */)
b[j++] = 0;
for (i = 0; i < h && j < fb.height; i++)
{
Lisp_Object elt = Faref (bits, make_number (i));
b[j++] = NUMBERP (elt) ? XINT (elt) : 0;
Lisp_Object elt = Faref (bits, make_fixnum (i));
b[j++] = FIXED_OR_FLOATP (elt) ? XFIXNUM (elt) : 0;
}
for (i = 0; i < fill2 && j < fb.height; i++)
b[j++] = 0;
@ -1661,10 +1661,10 @@ Return nil if POS is not visible in WINDOW. */)
if (!NILP (pos))
{
CHECK_NUMBER_COERCE_MARKER (pos);
if (! (BEGV <= XINT (pos) && XINT (pos) <= ZV))
CHECK_FIXNUM_COERCE_MARKER (pos);
if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV))
args_out_of_range (window, pos);
textpos = XINT (pos);
textpos = XFIXNUM (pos);
}
else if (w == XWINDOW (selected_window))
textpos = PT;

2
src/ftcrfont.c
View file

@ -137,7 +137,7 @@ ftcrfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
FT_UInt size;
block_input ();
size = XINT (AREF (entity, FONT_SIZE_INDEX));
size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
size = pixel_size;
font_object = font_build_object (VECSIZE (struct ftcrfont_info),

80
src/ftfont.c
View file

@ -196,7 +196,7 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
return Qnil;
file = (char *) str;
key = Fcons (build_unibyte_string (file), make_number (idx));
key = Fcons (build_unibyte_string (file), make_fixnum (idx));
cache = ftfont_lookup_cache (key, FTFONT_CACHE_FOR_ENTITY);
entity = XCAR (cache);
if (! NILP (entity))
@ -232,35 +232,35 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
{
if (numeric >= FC_WEIGHT_REGULAR && numeric < FC_WEIGHT_MEDIUM)
numeric = FC_WEIGHT_MEDIUM;
FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, make_number (numeric));
FONT_SET_STYLE (entity, FONT_WEIGHT_INDEX, make_fixnum (numeric));
}
if (FcPatternGetInteger (p, FC_SLANT, 0, &numeric) == FcResultMatch)
{
numeric += 100;
FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_number (numeric));
FONT_SET_STYLE (entity, FONT_SLANT_INDEX, make_fixnum (numeric));
}
if (FcPatternGetInteger (p, FC_WIDTH, 0, &numeric) == FcResultMatch)
{
FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_number (numeric));
FONT_SET_STYLE (entity, FONT_WIDTH_INDEX, make_fixnum (numeric));
}
if (FcPatternGetDouble (p, FC_PIXEL_SIZE, 0, &dbl) == FcResultMatch)
{
ASET (entity, FONT_SIZE_INDEX, make_number (dbl));
ASET (entity, FONT_SIZE_INDEX, make_fixnum (dbl));
}
else
ASET (entity, FONT_SIZE_INDEX, make_number (0));
ASET (entity, FONT_SIZE_INDEX, make_fixnum (0));
if (FcPatternGetInteger (p, FC_SPACING, 0, &numeric) == FcResultMatch)
ASET (entity, FONT_SPACING_INDEX, make_number (numeric));
ASET (entity, FONT_SPACING_INDEX, make_fixnum (numeric));
if (FcPatternGetDouble (p, FC_DPI, 0, &dbl) == FcResultMatch)
{
int dpi = dbl;
ASET (entity, FONT_DPI_INDEX, make_number (dpi));
ASET (entity, FONT_DPI_INDEX, make_fixnum (dpi));
}
if (FcPatternGetBool (p, FC_SCALABLE, 0, &b) == FcResultMatch
&& b == FcTrue)
{
ASET (entity, FONT_SIZE_INDEX, make_number (0));
ASET (entity, FONT_AVGWIDTH_INDEX, make_number (0));
ASET (entity, FONT_SIZE_INDEX, make_fixnum (0));
ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (0));
}
else
{
@ -276,7 +276,7 @@ ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
if (FT_Get_BDF_Property (ft_face, "AVERAGE_WIDTH", &rec) == 0
&& rec.type == BDF_PROPERTY_TYPE_INTEGER)
ASET (entity, FONT_AVGWIDTH_INDEX, make_number (rec.u.integer));
ASET (entity, FONT_AVGWIDTH_INDEX, make_fixnum (rec.u.integer));
FT_Done_Face (ft_face);
}
}
@ -390,7 +390,7 @@ ftfont_lookup_cache (Lisp_Object key, enum ftfont_cache_for cache_for)
? ! cache_data->ft_face : ! cache_data->fc_charset)
{
char *filename = SSDATA (XCAR (key));
int idx = XINT (XCDR (key));
int idx = XFIXNUM (XCDR (key));
if (cache_for == FTFONT_CACHE_FOR_FACE)
{
@ -600,9 +600,9 @@ ftfont_get_open_type_spec (Lisp_Object otf_spec)
continue;
len = Flength (val);
spec->features[i] =
(min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XINT (len)
(min (PTRDIFF_MAX, SIZE_MAX) / sizeof (int) < XFIXNUM (len)
? 0
: malloc (XINT (len) * sizeof *spec->features[i]));
: malloc (XFIXNUM (len) * sizeof *spec->features[i]));
if (! spec->features[i])
{
if (i > 0 && spec->features[0])
@ -646,10 +646,10 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots
/* Fontconfig doesn't support reverse-italic/oblique. */
return NULL;
if (INTEGERP (AREF (spec, FONT_DPI_INDEX)))
dpi = XINT (AREF (spec, FONT_DPI_INDEX));
if (INTEGERP (AREF (spec, FONT_AVGWIDTH_INDEX))
&& XINT (AREF (spec, FONT_AVGWIDTH_INDEX)) == 0)
if (FIXNUMP (AREF (spec, FONT_DPI_INDEX)))
dpi = XFIXNUM (AREF (spec, FONT_DPI_INDEX));
if (FIXNUMP (AREF (spec, FONT_AVGWIDTH_INDEX))
&& XFIXNUM (AREF (spec, FONT_AVGWIDTH_INDEX)) == 0)
scalable = 1;
registry = AREF (spec, FONT_REGISTRY_INDEX);
@ -686,8 +686,8 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots
key = XCAR (XCAR (extra)), val = XCDR (XCAR (extra));
if (EQ (key, QCdpi))
{
if (INTEGERP (val))
dpi = XINT (val);
if (FIXNUMP (val))
dpi = XFIXNUM (val);
}
else if (EQ (key, QClang))
{
@ -735,7 +735,7 @@ ftfont_spec_pattern (Lisp_Object spec, char *otlayout, struct OpenTypeSpec **ots
goto err;
for (chars = XCDR (chars); CONSP (chars); chars = XCDR (chars))
if (CHARACTERP (XCAR (chars))
&& ! FcCharSetAddChar (charset, XFASTINT (XCAR (chars))))
&& ! FcCharSetAddChar (charset, XFIXNAT (XCAR (chars))))
goto err;
}
}
@ -832,8 +832,8 @@ ftfont_list (struct frame *f, Lisp_Object spec)
}
val = Qnil;
}
if (INTEGERP (AREF (spec, FONT_SPACING_INDEX)))
spacing = XINT (AREF (spec, FONT_SPACING_INDEX));
if (FIXNUMP (AREF (spec, FONT_SPACING_INDEX)))
spacing = XFIXNUM (AREF (spec, FONT_SPACING_INDEX));
family = AREF (spec, FONT_FAMILY_INDEX);
if (! NILP (family))
{
@ -955,8 +955,8 @@ ftfont_list (struct frame *f, Lisp_Object spec)
!= FcResultMatch)
continue;
for (j = 0; j < ASIZE (chars); j++)
if (TYPE_RANGED_INTEGERP (FcChar32, AREF (chars, j))
&& FcCharSetHasChar (charset, XFASTINT (AREF (chars, j))))
if (TYPE_RANGED_FIXNUMP (FcChar32, AREF (chars, j))
&& FcCharSetHasChar (charset, XFIXNAT (AREF (chars, j))))
break;
if (j == ASIZE (chars))
continue;
@ -1016,12 +1016,12 @@ ftfont_match (struct frame *f, Lisp_Object spec)
if (! pattern)
return Qnil;
if (INTEGERP (AREF (spec, FONT_SIZE_INDEX)))
if (FIXNUMP (AREF (spec, FONT_SIZE_INDEX)))
{
FcValue value;
value.type = FcTypeDouble;
value.u.d = XINT (AREF (spec, FONT_SIZE_INDEX));
value.u.d = XFIXNUM (AREF (spec, FONT_SIZE_INDEX));
FcPatternAdd (pattern, FC_PIXEL_SIZE, value, FcFalse);
}
if (FcConfigSubstitute (NULL, pattern, FcMatchPattern) == FcTrue)
@ -1130,7 +1130,7 @@ ftfont_open2 (struct frame *f,
return Qnil;
}
}
size = XINT (AREF (entity, FONT_SIZE_INDEX));
size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
size = pixel_size;
if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0)
@ -1148,7 +1148,7 @@ ftfont_open2 (struct frame *f,
font = XFONT_OBJECT (font_object);
ftfont_info = (struct ftfont_info *) font;
ftfont_info->ft_size = ft_face->size;
ftfont_info->index = XINT (idx);
ftfont_info->index = XFIXNUM (idx);
#ifdef HAVE_LIBOTF
ftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
ftfont_info->otf = NULL;
@ -1160,8 +1160,8 @@ ftfont_open2 (struct frame *f,
font->encoding_charset = font->repertory_charset = -1;
upEM = ft_face->units_per_EM;
scalable = (INTEGERP (AREF (entity, FONT_AVGWIDTH_INDEX))
&& XINT (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0);
scalable = (FIXNUMP (AREF (entity, FONT_AVGWIDTH_INDEX))
&& XFIXNUM (AREF (entity, FONT_AVGWIDTH_INDEX)) == 0);
if (scalable)
{
font->ascent = ft_face->ascender * size / upEM + 0.5;
@ -1174,8 +1174,8 @@ ftfont_open2 (struct frame *f,
font->descent = - ft_face->size->metrics.descender >> 6;
font->height = ft_face->size->metrics.height >> 6;
}
if (INTEGERP (AREF (entity, FONT_SPACING_INDEX)))
spacing = XINT (AREF (entity, FONT_SPACING_INDEX));
if (FIXNUMP (AREF (entity, FONT_SPACING_INDEX)))
spacing = XFIXNUM (AREF (entity, FONT_SPACING_INDEX));
else
spacing = FC_PROPORTIONAL;
if (spacing != FC_PROPORTIONAL
@ -1233,7 +1233,7 @@ ftfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
{
Lisp_Object font_object;
FT_UInt size;
size = XINT (AREF (entity, FONT_SIZE_INDEX));
size = XFIXNUM (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
size = pixel_size;
font_object = font_build_object (VECSIZE (struct ftfont_info),
@ -1250,7 +1250,7 @@ ftfont_close (struct font *font)
struct ftfont_info *ftfont_info = (struct ftfont_info *) font;
Lisp_Object val, cache;
val = Fcons (font->props[FONT_FILE_INDEX], make_number (ftfont_info->index));
val = Fcons (font->props[FONT_FILE_INDEX], make_fixnum (ftfont_info->index));
cache = ftfont_lookup_cache (val, FTFONT_CACHE_FOR_FACE);
eassert (CONSP (cache));
val = XCDR (cache);
@ -2534,7 +2534,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
flt = mflt_find (LGLYPH_CHAR (LGSTRING_GLYPH (lgstring, 0)),
&flt_font_ft.flt_font);
if (! flt)
return make_number (0);
return make_fixnum (0);
}
MFLTGlyphFT *glyphs = (MFLTGlyphFT *) gstring.glyphs;
@ -2603,13 +2603,13 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
{
Lisp_Object vec = make_uninit_vector (3);
ASET (vec, 0, make_number (g->g.xoff >> 6));
ASET (vec, 1, make_number (g->g.yoff >> 6));
ASET (vec, 2, make_number (g->g.xadv >> 6));
ASET (vec, 0, make_fixnum (g->g.xoff >> 6));
ASET (vec, 1, make_fixnum (g->g.yoff >> 6));
ASET (vec, 2, make_fixnum (g->g.xadv >> 6));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
}
return make_number (i);
return make_fixnum (i);
}
Lisp_Object

15
src/gfilenotify.c
View file

@ -77,7 +77,6 @@ dir_monitor_callback (GFileMonitor *monitor,
/* Determine callback function. */
monitor_object = make_pointer_integer (monitor);
eassert (INTEGERP (monitor_object));
watch_object = assq_no_quit (monitor_object, watch_list);
if (CONSP (watch_object))
@ -203,10 +202,10 @@ will be reported only in case of the `moved' event. */)
if (! monitor)
xsignal2 (Qfile_notify_error, build_string ("Cannot watch file"), file);
Lisp_Object watch_descriptor = make_pointer_integer (monitor);
Lisp_Object watch_descriptor = make_pointer_integer_unsafe (monitor);
/* Check the dicey assumption that make_pointer_integer is safe. */
if (! INTEGERP (watch_descriptor))
if (! (FIXNUMP (watch_descriptor)
&& XFIXNUMPTR (watch_descriptor) == monitor))
{
g_object_unref (monitor);
xsignal2 (Qfile_notify_error, build_string ("Unsupported file watcher"),
@ -239,8 +238,8 @@ WATCH-DESCRIPTOR should be an object returned by `gfile-add-watch'. */)
xsignal2 (Qfile_notify_error, build_string ("Not a watch descriptor"),
watch_descriptor);
eassert (INTEGERP (watch_descriptor));
GFileMonitor *monitor = XINTPTR (watch_descriptor);
eassert (FIXNUMP (watch_descriptor));
GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor);
if (!g_file_monitor_is_cancelled (monitor) &&
!g_file_monitor_cancel (monitor))
xsignal2 (Qfile_notify_error, build_string ("Could not rm watch"),
@ -271,7 +270,7 @@ invalid. */)
return Qnil;
else
{
GFileMonitor *monitor = XINTPTR (watch_descriptor);
GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor);
return g_file_monitor_is_cancelled (monitor) ? Qnil : Qt;
}
}
@ -290,7 +289,7 @@ If WATCH-DESCRIPTOR is not valid, nil is returned. */)
return Qnil;
else
{
GFileMonitor *monitor = XINTPTR (watch_descriptor);
GFileMonitor *monitor = XFIXNUMPTR (watch_descriptor);
return intern (G_OBJECT_TYPE_NAME (monitor));
}
}

92
src/gnutls.c
View file

@ -816,7 +816,7 @@ gnutls_make_error (int err)
}
check_memory_full (err);
return make_number (err);
return make_fixnum (err);
}
static void
@ -893,7 +893,7 @@ See also `gnutls-boot'. */)
{
CHECK_PROCESS (proc);
return make_number (GNUTLS_INITSTAGE (proc));
return make_fixnum (GNUTLS_INITSTAGE (proc));
}
DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
@ -923,7 +923,7 @@ Usage: (gnutls-error-fatalp ERROR) */)
if (SYMBOLP (err))
{
code = Fget (err, Qgnutls_code);
if (NUMBERP (code))
if (FIXED_OR_FLOATP (code))
{
err = code;
}
@ -933,10 +933,10 @@ Usage: (gnutls-error-fatalp ERROR) */)
}
}
if (! TYPE_RANGED_INTEGERP (int, err))
if (! TYPE_RANGED_FIXNUMP (int, err))
error ("Not an error symbol or code");
if (0 == gnutls_error_is_fatal (XINT (err)))
if (0 == gnutls_error_is_fatal (XFIXNUM (err)))
return Qnil;
return Qt;
@ -955,7 +955,7 @@ usage: (gnutls-error-string ERROR) */)
if (SYMBOLP (err))
{
code = Fget (err, Qgnutls_code);
if (NUMBERP (code))
if (FIXED_OR_FLOATP (code))
{
err = code;
}
@ -965,10 +965,10 @@ usage: (gnutls-error-string ERROR) */)
}
}
if (! TYPE_RANGED_INTEGERP (int, err))
if (! TYPE_RANGED_FIXNUMP (int, err))
return build_string ("Not an error symbol or code");
return build_string (emacs_gnutls_strerror (XINT (err)));
return build_string (emacs_gnutls_strerror (XFIXNUM (err)));
}
DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@ -1012,7 +1012,7 @@ gnutls_certificate_details (gnutls_x509_crt_t cert)
check_memory_full (version);
if (version >= GNUTLS_E_SUCCESS)
res = nconc2 (res, list2 (intern (":version"),
make_number (version)));
make_fixnum (version)));
}
/* Serial. */
@ -1296,7 +1296,7 @@ returned as the :certificate entry. */)
check_memory_full (bits);
if (bits > 0)
result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"),
make_number (bits)));
make_fixnum (bits)));
}
/* Key exchange. */
@ -1650,14 +1650,14 @@ one trustfile (usually a CA bundle). */)
state = XPROCESS (proc)->gnutls_state;
if (TYPE_RANGED_INTEGERP (int, loglevel))
if (TYPE_RANGED_FIXNUMP (int, loglevel))
{
gnutls_global_set_log_function (gnutls_log_function);
# ifdef HAVE_GNUTLS3
gnutls_global_set_audit_log_function (gnutls_audit_log_function);
# endif
gnutls_global_set_log_level (XINT (loglevel));
max_log_level = XINT (loglevel);
gnutls_global_set_log_level (XFIXNUM (loglevel));
max_log_level = XFIXNUM (loglevel);
XPROCESS (proc)->gnutls_log_level = max_log_level;
}
@ -1690,9 +1690,9 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
verify_flags = Fplist_get (proplist, QCverify_flags);
if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags))
if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags))
{
gnutls_verify_flags = XFASTINT (verify_flags);
gnutls_verify_flags = XFIXNAT (verify_flags);
GNUTLS_LOG (2, max_log_level, "setting verification flags");
}
else if (NILP (verify_flags))
@ -1851,8 +1851,8 @@ one trustfile (usually a CA bundle). */)
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
if (INTEGERP (prime_bits))
gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
if (FIXNUMP (prime_bits))
gnutls_dh_set_prime_bits (state, XUFIXNUM (prime_bits));
ret = EQ (type, Qgnutls_x509pki)
? gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
@ -1937,19 +1937,19 @@ The alist key is the cipher name. */)
Lisp_Object cp
= listn (CONSTYPE_HEAP, 15, cipher_symbol,
QCcipher_id, make_number (gca),
QCcipher_id, make_fixnum (gca),
QCtype, Qgnutls_type_cipher,
QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt,
QCcipher_tagsize, make_number (cipher_tag_size),
QCcipher_tagsize, make_fixnum (cipher_tag_size),
QCcipher_blocksize,
make_number (gnutls_cipher_get_block_size (gca)),
make_fixnum (gnutls_cipher_get_block_size (gca)),
QCcipher_keysize,
make_number (gnutls_cipher_get_key_size (gca)),
make_fixnum (gnutls_cipher_get_key_size (gca)),
QCcipher_ivsize,
make_number (gnutls_cipher_get_iv_size (gca)));
make_fixnum (gnutls_cipher_get_iv_size (gca)));
ciphers = Fcons (cp, ciphers);
}
@ -2079,16 +2079,16 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher,
cipher);
info = XCDR (info);
}
else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher))
gca = XINT (cipher);
else if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, cipher))
gca = XFIXNUM (cipher);
else
info = cipher;
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCcipher_id);
if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v))
gca = XINT (v);
if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v))
gca = XFIXNUM (v);
}
ptrdiff_t key_size = gnutls_cipher_get_key_size (gca);
@ -2268,17 +2268,17 @@ name. */)
nonce_size = gnutls_mac_get_nonce_size (gma);
#endif
Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol,
QCmac_algorithm_id, make_number (gma),
QCmac_algorithm_id, make_fixnum (gma),
QCtype, Qgnutls_type_mac_algorithm,
QCmac_algorithm_length,
make_number (gnutls_hmac_get_len (gma)),
make_fixnum (gnutls_hmac_get_len (gma)),
QCmac_algorithm_keysize,
make_number (gnutls_mac_get_key_size (gma)),
make_fixnum (gnutls_mac_get_key_size (gma)),
QCmac_algorithm_noncesize,
make_number (nonce_size));
make_fixnum (nonce_size));
mac_algorithms = Fcons (mp, mac_algorithms);
}
@ -2303,11 +2303,11 @@ method name. */)
Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda));
Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol,
QCdigest_algorithm_id, make_number (gda),
QCdigest_algorithm_id, make_fixnum (gda),
QCtype, Qgnutls_type_digest_algorithm,
QCdigest_algorithm_length,
make_number (gnutls_hash_get_len (gda)));
make_fixnum (gnutls_hash_get_len (gda)));
digest_algorithms = Fcons (mp, digest_algorithms);
}
@ -2358,16 +2358,16 @@ itself. */)
hash_method);
info = XCDR (info);
}
else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method))
gma = XINT (hash_method);
else if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, hash_method))
gma = XFIXNUM (hash_method);
else
info = hash_method;
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v))
gma = XINT (v);
if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v))
gma = XFIXNUM (v);
}
ptrdiff_t digest_length = gnutls_hmac_get_len (gma);
@ -2448,16 +2448,16 @@ the number itself. */)
digest_method);
info = XCDR (info);
}
else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method))
gda = XINT (digest_method);
else if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, digest_method))
gda = XFIXNUM (digest_method);
else
info = digest_method;
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v))
gda = XINT (v);
if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v))
gda = XFIXNUM (v);
}
ptrdiff_t digest_length = gnutls_hash_get_len (gda);
@ -2571,11 +2571,11 @@ syms_of_gnutls (void)
DEFSYM (Qlibgnutls_version, "libgnutls-version");
Fset (Qlibgnutls_version,
#ifdef HAVE_GNUTLS
make_number (GNUTLS_VERSION_MAJOR * 10000
make_fixnum (GNUTLS_VERSION_MAJOR * 10000
+ GNUTLS_VERSION_MINOR * 100
+ GNUTLS_VERSION_PATCH)
#else
make_number (-1)
make_fixnum (-1)
#endif
);
#ifdef HAVE_GNUTLS
@ -2619,19 +2619,19 @@ syms_of_gnutls (void)
DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
make_number (GNUTLS_E_INTERRUPTED));
make_fixnum (GNUTLS_E_INTERRUPTED));
DEFSYM (Qgnutls_e_again, "gnutls-e-again");
Fput (Qgnutls_e_again, Qgnutls_code,
make_number (GNUTLS_E_AGAIN));
make_fixnum (GNUTLS_E_AGAIN));
DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
Fput (Qgnutls_e_invalid_session, Qgnutls_code,
make_number (GNUTLS_E_INVALID_SESSION));
make_fixnum (GNUTLS_E_INVALID_SESSION));
DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
make_fixnum (GNUTLS_E_APPLICATION_ERROR_MIN));
defsubr (&Sgnutls_get_initstage);
defsubr (&Sgnutls_asynchronous_parameters);

24
src/gtkutil.c
View file

@ -963,7 +963,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
{
frame_size_history_add
(f, Qxg_frame_set_char_size_1, width, height,
list2 (make_number (gheight), make_number (totalheight)));
list2 (make_fixnum (gheight), make_fixnum (totalheight)));
gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
gwidth, totalheight);
@ -972,7 +972,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
{
frame_size_history_add
(f, Qxg_frame_set_char_size_2, width, height,
list2 (make_number (gwidth), make_number (totalwidth)));
list2 (make_fixnum (gwidth), make_fixnum (totalwidth)));
gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
totalwidth, gheight);
@ -981,7 +981,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
{
frame_size_history_add
(f, Qxg_frame_set_char_size_3, width, height,
list2 (make_number (totalwidth), make_number (totalheight)));
list2 (make_fixnum (totalwidth), make_fixnum (totalheight)));
gtk_window_resize (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)),
totalwidth, totalheight);
@ -4279,7 +4279,7 @@ draw_page (GtkPrintOperation *operation, GtkPrintContext *context,
gint page_nr, gpointer user_data)
{
Lisp_Object frames = *((Lisp_Object *) user_data);
struct frame *f = XFRAME (Fnth (make_number (page_nr), frames));
struct frame *f = XFRAME (Fnth (make_fixnum (page_nr), frames));
cairo_t *cr = gtk_print_context_get_cairo_context (context);
x_cr_draw_frame (cr, f);
@ -4296,7 +4296,7 @@ xg_print_frames_dialog (Lisp_Object frames)
gtk_print_operation_set_print_settings (print, print_settings);
if (page_setup != NULL)
gtk_print_operation_set_default_page_setup (print, page_setup);
gtk_print_operation_set_n_pages (print, XINT (Flength (frames)));
gtk_print_operation_set_n_pages (print, XFIXNUM (Flength (frames)));
g_signal_connect (print, "draw-page", G_CALLBACK (draw_page), &frames);
res = gtk_print_operation_run (print, GTK_PRINT_OPERATION_ACTION_PRINT_DIALOG,
NULL, NULL);
@ -4889,18 +4889,18 @@ update_frame_tool_bar (struct frame *f)
block_input ();
if (RANGED_INTEGERP (1, Vtool_bar_button_margin, INT_MAX))
if (RANGED_FIXNUMP (1, Vtool_bar_button_margin, INT_MAX))
{
hmargin = XFASTINT (Vtool_bar_button_margin);
vmargin = XFASTINT (Vtool_bar_button_margin);
hmargin = XFIXNAT (Vtool_bar_button_margin);
vmargin = XFIXNAT (Vtool_bar_button_margin);
}
else if (CONSP (Vtool_bar_button_margin))
{
if (RANGED_INTEGERP (1, XCAR (Vtool_bar_button_margin), INT_MAX))
hmargin = XFASTINT (XCAR (Vtool_bar_button_margin));
if (RANGED_FIXNUMP (1, XCAR (Vtool_bar_button_margin), INT_MAX))
hmargin = XFIXNAT (XCAR (Vtool_bar_button_margin));
if (RANGED_INTEGERP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
vmargin = XFASTINT (XCDR (Vtool_bar_button_margin));
if (RANGED_FIXNUMP (1, XCDR (Vtool_bar_button_margin), INT_MAX))
vmargin = XFIXNAT (XCDR (Vtool_bar_button_margin));
}
/* The natural size (i.e. when GTK uses 0 as margin) looks best,

172
src/image.c
View file

@ -322,7 +322,7 @@ x_create_bitmap_from_file (struct frame *f, Lisp_Object file)
/* Search bitmap-file-path for the file, if appropriate. */
if (openp (Vx_bitmap_file_path, file, Qnil, &found,
make_number (R_OK), false)
make_fixnum (R_OK), false)
< 0)
return -1;
@ -761,23 +761,23 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
break;
case IMAGE_POSITIVE_INTEGER_VALUE:
if (! RANGED_INTEGERP (1, value, INT_MAX))
if (! RANGED_FIXNUMP (1, value, INT_MAX))
return 0;
break;
case IMAGE_NON_NEGATIVE_INTEGER_VALUE_OR_PAIR:
if (RANGED_INTEGERP (0, value, INT_MAX))
if (RANGED_FIXNUMP (0, value, INT_MAX))
break;
if (CONSP (value)
&& RANGED_INTEGERP (0, XCAR (value), INT_MAX)
&& RANGED_INTEGERP (0, XCDR (value), INT_MAX))
&& RANGED_FIXNUMP (0, XCAR (value), INT_MAX)
&& RANGED_FIXNUMP (0, XCDR (value), INT_MAX))
break;
return 0;
case IMAGE_ASCENT_VALUE:
if (SYMBOLP (value) && EQ (value, Qcenter))
break;
else if (RANGED_INTEGERP (0, value, 100))
else if (RANGED_FIXNUMP (0, value, 100))
break;
return 0;
@ -785,7 +785,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
/* Unlike the other integer-related cases, this one does not
verify that VALUE fits in 'int'. This is because callers
want EMACS_INT. */
if (!INTEGERP (value) || XINT (value) < 0)
if (!FIXNUMP (value) || XFIXNUM (value) < 0)
return 0;
break;
@ -799,12 +799,12 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords,
return 0;
case IMAGE_NUMBER_VALUE:
if (! NUMBERP (value))
if (! FIXED_OR_FLOATP (value))
return 0;
break;
case IMAGE_INTEGER_VALUE:
if (! TYPE_RANGED_INTEGERP (int, value))
if (! TYPE_RANGED_FIXNUMP (int, value))
return 0;
break;
@ -883,7 +883,7 @@ or omitted means use the selected frame. */)
size = Fcons (make_float ((double) width / FRAME_COLUMN_WIDTH (f)),
make_float ((double) height / FRAME_LINE_HEIGHT (f)));
else
size = Fcons (make_number (width), make_number (height));
size = Fcons (make_fixnum (width), make_fixnum (height));
}
else
error ("Invalid image specification");
@ -1004,9 +1004,9 @@ check_image_size (struct frame *f, int width, int height)
if (width <= 0 || height <= 0)
return 0;
if (INTEGERP (Vmax_image_size))
return (width <= XINT (Vmax_image_size)
&& height <= XINT (Vmax_image_size));
if (FIXNUMP (Vmax_image_size))
return (width <= XFIXNUM (Vmax_image_size)
&& height <= XFIXNUM (Vmax_image_size));
else if (FLOATP (Vmax_image_size))
{
if (f != NULL)
@ -1534,7 +1534,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
}
}
}
else if (INTEGERP (Vimage_cache_eviction_delay))
else if (FIXNUMP (Vimage_cache_eviction_delay))
{
/* Free cache based on timestamp. */
struct timespec old, t;
@ -1547,7 +1547,7 @@ clear_image_cache (struct frame *f, Lisp_Object filter)
/* If the number of cached images has grown unusually large,
decrease the cache eviction delay (Bug#6230). */
delay = XINT (Vimage_cache_eviction_delay);
delay = XFIXNUM (Vimage_cache_eviction_delay);
if (nimages > 40)
delay = 1600 * delay / nimages / nimages;
delay = max (delay, 1);
@ -1761,11 +1761,11 @@ lookup_image (struct frame *f, Lisp_Object spec)
Lisp_Object value;
value = image_spec_value (spec, QCwidth, NULL);
img->width = (INTEGERP (value)
? XFASTINT (value) : DEFAULT_IMAGE_WIDTH);
img->width = (FIXNUMP (value)
? XFIXNAT (value) : DEFAULT_IMAGE_WIDTH);
value = image_spec_value (spec, QCheight, NULL);
img->height = (INTEGERP (value)
? XFASTINT (value) : DEFAULT_IMAGE_HEIGHT);
img->height = (FIXNUMP (value)
? XFIXNAT (value) : DEFAULT_IMAGE_HEIGHT);
}
else
{
@ -1776,25 +1776,25 @@ lookup_image (struct frame *f, Lisp_Object spec)
int relief_bound;
ascent = image_spec_value (spec, QCascent, NULL);
if (INTEGERP (ascent))
img->ascent = XFASTINT (ascent);
if (FIXNUMP (ascent))
img->ascent = XFIXNAT (ascent);
else if (EQ (ascent, Qcenter))
img->ascent = CENTERED_IMAGE_ASCENT;
margin = image_spec_value (spec, QCmargin, NULL);
if (INTEGERP (margin))
img->vmargin = img->hmargin = XFASTINT (margin);
if (FIXNUMP (margin))
img->vmargin = img->hmargin = XFIXNAT (margin);
else if (CONSP (margin))
{
img->hmargin = XFASTINT (XCAR (margin));
img->vmargin = XFASTINT (XCDR (margin));
img->hmargin = XFIXNAT (XCAR (margin));
img->vmargin = XFIXNAT (XCDR (margin));
}
relief = image_spec_value (spec, QCrelief, NULL);
relief_bound = INT_MAX - max (img->hmargin, img->vmargin);
if (RANGED_INTEGERP (- relief_bound, relief, relief_bound))
if (RANGED_FIXNUMP (- relief_bound, relief, relief_bound))
{
img->relief = XINT (relief);
img->relief = XFIXNUM (relief);
img->hmargin += eabs (img->relief);
img->vmargin += eabs (img->relief);
}
@ -1973,7 +1973,7 @@ x_create_x_image_and_pixmap (struct frame *f, int width, int height, int depth,
x_destroy_x_image (*ximg);
*ximg = NULL;
image_error ("Image too large (%dx%d)",
make_number (width), make_number (height));
make_fixnum (width), make_fixnum (height));
return 0;
}
@ -2306,7 +2306,7 @@ x_find_image_fd (Lisp_Object file, int *pfd)
/* Try to find FILE in data-directory/images, then x-bitmap-file-path. */
fd = openp (search_path, file, Qnil, &file_found,
pfd ? Qt : make_number (R_OK), false);
pfd ? Qt : make_fixnum (R_OK), false);
if (fd >= 0 || fd == -2)
{
file_found = ENCODE_FILE (file_found);
@ -2512,8 +2512,8 @@ xbm_image_p (Lisp_Object object)
return 0;
data = kw[XBM_DATA].value;
width = XFASTINT (kw[XBM_WIDTH].value);
height = XFASTINT (kw[XBM_HEIGHT].value);
width = XFIXNAT (kw[XBM_WIDTH].value);
height = XFIXNAT (kw[XBM_HEIGHT].value);
/* Check type of data, and width and height against contents of
data. */
@ -2875,7 +2875,7 @@ xbm_read_bitmap_data (struct frame *f, char *contents, char *end,
{
if (!inhibit_image_error)
image_error ("Image too large (%dx%d)",
make_number (*width), make_number (*height));
make_fixnum (*width), make_fixnum (*height));
goto failure;
}
bytes_per_line = (*width + 7) / 8 + padding_p;
@ -3061,8 +3061,8 @@ xbm_load (struct frame *f, struct image *img)
/* Get specified width, and height. */
if (!in_memory_file_p)
{
img->width = XFASTINT (fmt[XBM_WIDTH].value);
img->height = XFASTINT (fmt[XBM_HEIGHT].value);
img->width = XFIXNAT (fmt[XBM_WIDTH].value);
img->height = XFIXNAT (fmt[XBM_HEIGHT].value);
eassert (img->width > 0 && img->height > 0);
if (!check_image_size (f, img->width, img->height))
{
@ -4000,7 +4000,7 @@ xpm_make_color_table_v (void (**put_func) (Lisp_Object, const char *, int,
{
*put_func = xpm_put_color_table_v;
*get_func = xpm_get_color_table_v;
return Fmake_vector (make_number (256), Qnil);
return Fmake_vector (make_fixnum (256), Qnil);
}
static void
@ -4168,7 +4168,7 @@ xpm_load_image (struct frame *f,
if (!NILP (Fxw_display_color_p (frame)))
best_key = XPM_COLOR_KEY_C;
else if (!NILP (Fx_display_grayscale_p (frame)))
best_key = (XFASTINT (Fx_display_planes (frame)) > 2
best_key = (XFIXNAT (Fx_display_planes (frame)) > 2
? XPM_COLOR_KEY_G : XPM_COLOR_KEY_G4);
else
best_key = XPM_COLOR_KEY_M;
@ -4239,7 +4239,7 @@ xpm_load_image (struct frame *f,
color_val = Qt;
else if (x_defined_color (f, SSDATA (XCDR (specified_color)),
&cdef, 0))
color_val = make_number (cdef.pixel);
color_val = make_fixnum (cdef.pixel);
}
}
if (NILP (color_val) && max_key > 0)
@ -4247,7 +4247,7 @@ xpm_load_image (struct frame *f,
if (xstrcasecmp (max_color, "None") == 0)
color_val = Qt;
else if (x_defined_color (f, max_color, &cdef, 0))
color_val = make_number (cdef.pixel);
color_val = make_fixnum (cdef.pixel);
}
if (!NILP (color_val))
(*put_color_table) (color_table, beg, chars_per_pixel, color_val);
@ -4267,7 +4267,7 @@ xpm_load_image (struct frame *f,
(*get_color_table) (color_table, str, chars_per_pixel);
XPutPixel (ximg, x, y,
(INTEGERP (color_val) ? XINT (color_val)
(FIXNUMP (color_val) ? XFIXNUM (color_val)
: FRAME_FOREGROUND_PIXEL (f)));
#ifndef HAVE_NS
XPutPixel (mask_img, x, y,
@ -4928,20 +4928,20 @@ x_edge_detection (struct frame *f, struct image *img, Lisp_Object matrix,
if (CONSP (matrix))
{
for (i = 0;
i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
i < 9 && CONSP (matrix) && FIXED_OR_FLOATP (XCAR (matrix));
++i, matrix = XCDR (matrix))
trans[i] = XFLOATINT (XCAR (matrix));
}
else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
{
for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
for (i = 0; i < 9 && FIXED_OR_FLOATP (AREF (matrix, i)); ++i)
trans[i] = XFLOATINT (AREF (matrix, i));
}
if (NILP (color_adjust))
color_adjust = make_number (0xffff / 2);
color_adjust = make_fixnum (0xffff / 2);
if (i == 9 && NUMBERP (color_adjust))
if (i == 9 && FIXED_OR_FLOATP (color_adjust))
x_detect_edges (f, img, trans, XFLOATINT (color_adjust));
}
@ -5093,9 +5093,9 @@ x_build_heuristic_mask (struct frame *f, struct image *img, Lisp_Object how)
{
int rgb[3], i;
for (i = 0; i < 3 && CONSP (how) && NATNUMP (XCAR (how)); ++i)
for (i = 0; i < 3 && CONSP (how) && FIXNATP (XCAR (how)); ++i)
{
rgb[i] = XFASTINT (XCAR (how)) & 0xffff;
rgb[i] = XFIXNAT (XCAR (how)) & 0xffff;
how = XCDR (how);
}
@ -7280,9 +7280,9 @@ tiff_load (struct frame *f, struct image *img)
}
image = image_spec_value (img->spec, QCindex, NULL);
if (INTEGERP (image))
if (FIXNUMP (image))
{
EMACS_INT ino = XFASTINT (image);
EMACS_INT ino = XFIXNAT (image);
if (! (TYPE_MINIMUM (tdir_t) <= ino && ino <= TYPE_MAXIMUM (tdir_t)
&& TIFFSetDirectory (tiff, ino)))
{
@ -7324,7 +7324,7 @@ tiff_load (struct frame *f, struct image *img)
if (count > 1)
img->lisp_data = Fcons (Qcount,
Fcons (make_number (count),
Fcons (make_fixnum (count),
img->lisp_data));
TIFFClose (tiff);
@ -7746,7 +7746,7 @@ gif_load (struct frame *f, struct image *img)
/* Which sub-image are we to display? */
{
Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL);
idx = INTEGERP (image_number) ? XFASTINT (image_number) : 0;
idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0;
if (idx < 0 || idx >= gif->ImageCount)
{
image_error ("Invalid image number `%s' in image `%s'",
@ -8000,7 +8000,7 @@ gif_load (struct frame *f, struct image *img)
/* Append (... FUNCTION "BYTES") */
{
img->lisp_data
= Fcons (make_number (ext->Function),
= Fcons (make_fixnum (ext->Function),
Fcons (make_unibyte_string ((char *) ext->Bytes,
ext->ByteCount),
img->lisp_data));
@ -8021,7 +8021,7 @@ gif_load (struct frame *f, struct image *img)
if (gif->ImageCount > 1)
img->lisp_data = Fcons (Qcount,
Fcons (make_number (gif->ImageCount),
Fcons (make_fixnum (gif->ImageCount),
img->lisp_data));
if (gif_close (gif, &gif_err) == GIF_ERROR)
@ -8102,33 +8102,33 @@ compute_image_size (size_t width, size_t height,
double scale = 1;
value = image_spec_value (spec, QCscale, NULL);
if (NUMBERP (value))
if (FIXED_OR_FLOATP (value))
scale = XFLOATINT (value);
value = image_spec_value (spec, QCmax_width, NULL);
if (NATNUMP (value))
max_width = min (XFASTINT (value), INT_MAX);
if (FIXNATP (value))
max_width = min (XFIXNAT (value), INT_MAX);
value = image_spec_value (spec, QCmax_height, NULL);
if (NATNUMP (value))
max_height = min (XFASTINT (value), INT_MAX);
if (FIXNATP (value))
max_height = min (XFIXNAT (value), INT_MAX);
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (spec, QCwidth, NULL);
if (NATNUMP (value))
if (FIXNATP (value))
{
desired_width = min (XFASTINT (value) * scale, INT_MAX);
desired_width = min (XFIXNAT (value) * scale, INT_MAX);
/* :width overrides :max-width. */
max_width = -1;
}
value = image_spec_value (spec, QCheight, NULL);
if (NATNUMP (value))
if (FIXNATP (value))
{
desired_height = min (XFASTINT (value) * scale, INT_MAX);
desired_height = min (XFIXNAT (value) * scale, INT_MAX);
/* :height overrides :max-height. */
max_height = -1;
}
@ -8573,7 +8573,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
find out things about it. */
image = image_spec_value (img->spec, QCindex, NULL);
ino = INTEGERP (image) ? XFASTINT (image) : 0;
ino = FIXNUMP (image) ? XFIXNAT (image) : 0;
image_wand = NewMagickWand ();
if (filename)
@ -8583,9 +8583,9 @@ imagemagick_load_image (struct frame *f, struct image *img,
Lisp_Object lwidth = image_spec_value (img->spec, QCwidth, NULL);
Lisp_Object lheight = image_spec_value (img->spec, QCheight, NULL);
if (NATNUMP (lwidth) && NATNUMP (lheight))
if (FIXNATP (lwidth) && FIXNATP (lheight))
{
MagickSetSize (image_wand, XFASTINT (lwidth), XFASTINT (lheight));
MagickSetSize (image_wand, XFIXNAT (lwidth), XFIXNAT (lheight));
MagickSetDepth (image_wand, 8);
}
filename_hint = imagemagick_filename_hint (img->spec, hint_buffer);
@ -8628,7 +8628,7 @@ imagemagick_load_image (struct frame *f, struct image *img,
if (MagickGetNumberImages (image_wand) > 1)
img->lisp_data =
Fcons (Qcount,
Fcons (make_number (MagickGetNumberImages (image_wand)),
Fcons (make_fixnum (MagickGetNumberImages (image_wand)),
img->lisp_data));
/* If we have an animated image, get the new wand based on the
@ -8678,26 +8678,26 @@ imagemagick_load_image (struct frame *f, struct image *img,
efficient. */
crop = image_spec_value (img->spec, QCcrop, NULL);
if (CONSP (crop) && TYPE_RANGED_INTEGERP (size_t, XCAR (crop)))
if (CONSP (crop) && TYPE_RANGED_FIXNUMP (size_t, XCAR (crop)))
{
/* After some testing, it seems MagickCropImage is the fastest crop
function in ImageMagick. This crop function seems to do less copying
than the alternatives, but it still reads the entire image into memory
before cropping, which is apparently difficult to avoid when using
imagemagick. */
size_t crop_width = XINT (XCAR (crop));
size_t crop_width = XFIXNUM (XCAR (crop));
crop = XCDR (crop);
if (CONSP (crop) && TYPE_RANGED_INTEGERP (size_t, XCAR (crop)))
if (CONSP (crop) && TYPE_RANGED_FIXNUMP (size_t, XCAR (crop)))
{
size_t crop_height = XINT (XCAR (crop));
size_t crop_height = XFIXNUM (XCAR (crop));
crop = XCDR (crop);
if (CONSP (crop) && TYPE_RANGED_INTEGERP (ssize_t, XCAR (crop)))
if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop)))
{
ssize_t crop_x = XINT (XCAR (crop));
ssize_t crop_x = XFIXNUM (XCAR (crop));
crop = XCDR (crop);
if (CONSP (crop) && TYPE_RANGED_INTEGERP (ssize_t, XCAR (crop)))
if (CONSP (crop) && TYPE_RANGED_FIXNUMP (ssize_t, XCAR (crop)))
{
ssize_t crop_y = XINT (XCAR (crop));
ssize_t crop_y = XFIXNUM (XCAR (crop));
MagickCropImage (image_wand, crop_width, crop_height,
crop_x, crop_y);
}
@ -9551,7 +9551,7 @@ gs_image_p (Lisp_Object object)
if (CONSP (tem))
{
for (i = 0; i < 4; ++i, tem = XCDR (tem))
if (!CONSP (tem) || !INTEGERP (XCAR (tem)))
if (!CONSP (tem) || !FIXNUMP (XCAR (tem)))
return 0;
if (!NILP (tem))
return 0;
@ -9561,7 +9561,7 @@ gs_image_p (Lisp_Object object)
if (ASIZE (tem) != 4)
return 0;
for (i = 0; i < 4; ++i)
if (!INTEGERP (AREF (tem, i)))
if (!FIXNUMP (AREF (tem, i)))
return 0;
}
else
@ -9589,10 +9589,10 @@ gs_load (struct frame *f, struct image *img)
= 1/72 in, xdpi and ydpi are stored in the frame's X display
info. */
pt_width = image_spec_value (img->spec, QCpt_width, NULL);
in_width = INTEGERP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0;
in_width = FIXNUMP (pt_width) ? XFIXNAT (pt_width) / 72.0 : 0;
in_width *= FRAME_RES_X (f);
pt_height = image_spec_value (img->spec, QCpt_height, NULL);
in_height = INTEGERP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0;
in_height = FIXNUMP (pt_height) ? XFIXNAT (pt_height) / 72.0 : 0;
in_height *= FRAME_RES_Y (f);
if (! (in_width <= INT_MAX && in_height <= INT_MAX
@ -9643,8 +9643,8 @@ gs_load (struct frame *f, struct image *img)
loader = intern ("gs-load-image");
img->lisp_data = call6 (loader, frame, img->spec,
make_number (img->width),
make_number (img->height),
make_fixnum (img->width),
make_fixnum (img->height),
window_and_pixmap_id,
pixel_colors);
return PROCESSP (img->lisp_data);
@ -9768,7 +9768,7 @@ DEFUN ("lookup-image", Flookup_image, Slookup_image, 1, 1, 0,
id = lookup_image (SELECTED_FRAME (), spec);
debug_print (spec);
return make_number (id);
return make_fixnum (id);
}
#endif /* GLYPH_DEBUG */
@ -9933,27 +9933,27 @@ non-numeric, there is no explicit limit on the size of images. */);
DEFSYM (Qlibpng_version, "libpng-version");
Fset (Qlibpng_version,
#if HAVE_PNG
make_number (PNG_LIBPNG_VER)
make_fixnum (PNG_LIBPNG_VER)
#else
make_number (-1)
make_fixnum (-1)
#endif
);
DEFSYM (Qlibgif_version, "libgif-version");
Fset (Qlibgif_version,
#ifdef HAVE_GIF
make_number (GIFLIB_MAJOR * 10000
make_fixnum (GIFLIB_MAJOR * 10000
+ GIFLIB_MINOR * 100
+ GIFLIB_RELEASE)
#else
make_number (-1)
make_fixnum (-1)
#endif
);
DEFSYM (Qlibjpeg_version, "libjpeg-version");
Fset (Qlibjpeg_version,
#if HAVE_JPEG
make_number (JPEG_LIB_VERSION)
make_fixnum (JPEG_LIB_VERSION)
#else
make_number (-1)
make_fixnum (-1)
#endif
);
#endif
@ -10038,7 +10038,7 @@ a large number of images, the actual eviction time may be shorter.
The value can also be nil, meaning the cache is never cleared.
The function `clear-image-cache' disregards this variable. */);
Vimage_cache_eviction_delay = make_number (300);
Vimage_cache_eviction_delay = make_fixnum (300);
#ifdef HAVE_IMAGEMAGICK
DEFVAR_INT ("imagemagick-render-type", imagemagick_render_type,
doc: /* Integer indicating which ImageMagick rendering method to use.

150
src/indent.c
View file

@ -116,7 +116,7 @@ disptab_matches_widthtab (struct Lisp_Char_Table *disptab, struct Lisp_Vector *w
for (i = 0; i < 256; i++)
if (character_width (i, disptab)
!= XFASTINT (widthtab->contents[i]))
!= XFIXNAT (widthtab->contents[i]))
return 0;
return 1;
@ -235,24 +235,24 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob
/* As for text properties, this gives a lower bound
for where the invisible text property could change. */
proplimit = Fnext_property_change (position, buffer, Qt);
if (XFASTINT (overlay_limit) < XFASTINT (proplimit))
if (XFIXNAT (overlay_limit) < XFIXNAT (proplimit))
proplimit = overlay_limit;
/* PROPLIMIT is now a lower bound for the next change
in invisible status. If that is plenty far away,
use that lower bound. */
if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to)
*next_boundary_p = XFASTINT (proplimit);
if (XFIXNAT (proplimit) > pos + 100 || XFIXNAT (proplimit) >= to)
*next_boundary_p = XFIXNAT (proplimit);
/* Otherwise, scan for the next `invisible' property change. */
else
{
/* Don't scan terribly far. */
XSETFASTINT (proplimit, min (pos + 100, to));
/* No matter what, don't go past next overlay change. */
if (XFASTINT (overlay_limit) < XFASTINT (proplimit))
if (XFIXNAT (overlay_limit) < XFIXNAT (proplimit))
proplimit = overlay_limit;
tmp = Fnext_single_property_change (position, Qinvisible,
buffer, proplimit);
end = XFASTINT (tmp);
end = XFIXNAT (tmp);
#if 0
/* Don't put the boundary in the middle of multibyte form if
there is no actual property change. */
@ -472,7 +472,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
Lisp_Object val, overlay;
if (CONSP (val = get_char_property_and_overlay
(make_number (pos), Qdisplay, Qnil, &overlay))
(make_fixnum (pos), Qdisplay, Qnil, &overlay))
&& EQ (Qspace, XCAR (val)))
{ /* FIXME: Use calc_pixel_width_or_height. */
Lisp_Object plist = XCDR (val), prop;
@ -483,16 +483,16 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
: MOST_POSITIVE_FIXNUM);
if ((prop = Fplist_get (plist, QCwidth),
RANGED_INTEGERP (0, prop, INT_MAX))
RANGED_FIXNUMP (0, prop, INT_MAX))
|| (prop = Fplist_get (plist, QCrelative_width),
RANGED_INTEGERP (0, prop, INT_MAX)))
width = XINT (prop);
RANGED_FIXNUMP (0, prop, INT_MAX)))
width = XFIXNUM (prop);
else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop)
&& XFLOAT_DATA (prop) <= INT_MAX)
width = (int)(XFLOAT_DATA (prop) + 0.5);
else if ((prop = Fplist_get (plist, QCalign_to),
RANGED_INTEGERP (col, prop, align_to_max)))
width = XINT (prop) - col;
RANGED_FIXNUMP (col, prop, align_to_max)))
width = XFIXNUM (prop) - col;
else if (FLOATP (prop) && col <= XFLOAT_DATA (prop)
&& (XFLOAT_DATA (prop) <= align_to_max))
width = (int)(XFLOAT_DATA (prop) + 0.5) - col;
@ -751,16 +751,16 @@ string_display_width (Lisp_Object string, Lisp_Object beg, Lisp_Object end)
e = SCHARS (string);
else
{
CHECK_NUMBER (end);
e = XINT (end);
CHECK_FIXNUM (end);
e = XFIXNUM (end);
}
if (NILP (beg))
b = 0;
else
{
CHECK_NUMBER (beg);
b = XINT (beg);
CHECK_FIXNUM (beg);
b = XFIXNUM (beg);
}
/* Make a pointer for decrementing through the chars before point. */
@ -820,32 +820,32 @@ The return value is the column where the insertion ends. */)
register ptrdiff_t fromcol;
int tab_width = SANE_TAB_WIDTH (current_buffer);
CHECK_NUMBER (column);
CHECK_FIXNUM (column);
if (NILP (minimum))
XSETFASTINT (minimum, 0);
CHECK_NUMBER (minimum);
CHECK_FIXNUM (minimum);
fromcol = current_column ();
mincol = fromcol + XINT (minimum);
if (mincol < XINT (column)) mincol = XINT (column);
mincol = fromcol + XFIXNUM (minimum);
if (mincol < XFIXNUM (column)) mincol = XFIXNUM (column);
if (fromcol == mincol)
return make_number (mincol);
return make_fixnum (mincol);
if (indent_tabs_mode)
{
Lisp_Object n;
XSETFASTINT (n, mincol / tab_width - fromcol / tab_width);
if (XFASTINT (n) != 0)
if (XFIXNAT (n) != 0)
{
Finsert_char (make_number ('\t'), n, Qt);
Finsert_char (make_fixnum ('\t'), n, Qt);
fromcol = (mincol / tab_width) * tab_width;
}
}
XSETFASTINT (column, mincol - fromcol);
Finsert_char (make_number (' '), column, Qt);
Finsert_char (make_fixnum (' '), column, Qt);
last_known_column = mincol;
last_known_column_point = PT;
@ -866,7 +866,7 @@ following any initial whitespace. */)
ptrdiff_t posbyte;
find_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, NULL, &posbyte, 1);
return make_number (position_indentation (posbyte));
return make_fixnum (position_indentation (posbyte));
}
static ptrdiff_t
@ -994,8 +994,8 @@ The return value is the current column. */)
EMACS_INT col;
EMACS_INT goal;
CHECK_NATNUM (column);
goal = XINT (column);
CHECK_FIXNAT (column);
goal = XFIXNUM (column);
col = goal;
pos = ZV;
@ -1020,13 +1020,13 @@ The return value is the current column. */)
first so that a marker at the end of the tab gets
adjusted. */
SET_PT_BOTH (PT - 1, PT_BYTE - 1);
Finsert_char (make_number (' '), make_number (goal - prev_col), Qt);
Finsert_char (make_fixnum (' '), make_fixnum (goal - prev_col), Qt);
/* Now delete the tab, and indent to COL. */
del_range (PT, PT + 1);
goal_pt = PT;
goal_pt_byte = PT_BYTE;
Findent_to (make_number (col), Qnil);
Findent_to (make_fixnum (col), Qnil);
SET_PT_BOTH (goal_pt, goal_pt_byte);
/* Set the last_known... vars consistently. */
@ -1036,13 +1036,13 @@ The return value is the current column. */)
/* If line ends prematurely, add space to the end. */
if (col < goal && EQ (force, Qt))
Findent_to (make_number (col = goal), Qnil);
Findent_to (make_fixnum (col = goal), Qnil);
last_known_column = col;
last_known_column_point = PT;
last_known_column_modified = MODIFF;
return make_number (col);
return make_fixnum (col);
}
/* compute_motion: compute buffer posn given screen posn and vice versa */
@ -1128,8 +1128,8 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
bool ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow));
struct Lisp_Char_Table *dp = window_display_table (win);
EMACS_INT selective
= (INTEGERP (BVAR (current_buffer, selective_display))
? XINT (BVAR (current_buffer, selective_display))
= (FIXNUMP (BVAR (current_buffer, selective_display))
? XFIXNUM (BVAR (current_buffer, selective_display))
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
ptrdiff_t selective_rlen
= (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp))
@ -1338,9 +1338,9 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
if (!NILP (Vtruncate_partial_width_windows)
&& (total_width < FRAME_COLS (XFRAME (WINDOW_FRAME (win)))))
{
if (INTEGERP (Vtruncate_partial_width_windows))
if (FIXNUMP (Vtruncate_partial_width_windows))
truncate
= total_width < XFASTINT (Vtruncate_partial_width_windows);
= total_width < XFIXNAT (Vtruncate_partial_width_windows);
else
truncate = 1;
}
@ -1533,7 +1533,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
/* Is this character part of the current run? If so, extend
the run. */
if (pos - 1 == width_run_end
&& XFASTINT (width_table[c]) == width_run_width)
&& XFIXNAT (width_table[c]) == width_run_width)
width_run_end = pos;
/* The previous run is over, since this is a character at a
@ -1548,7 +1548,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos,
width_run_start, width_run_end);
/* Start recording a new width run. */
width_run_width = XFASTINT (width_table[c]);
width_run_width = XFIXNAT (width_table[c]);
width_run_start = pos - 1;
width_run_end = pos;
}
@ -1754,48 +1754,48 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
ptrdiff_t hscroll;
int tab_offset;
CHECK_NUMBER_COERCE_MARKER (from);
CHECK_FIXNUM_COERCE_MARKER (from);
CHECK_CONS (frompos);
CHECK_NUMBER_CAR (frompos);
CHECK_NUMBER_CDR (frompos);
CHECK_NUMBER_COERCE_MARKER (to);
CHECK_FIXNUM_CAR (frompos);
CHECK_FIXNUM_CDR (frompos);
CHECK_FIXNUM_COERCE_MARKER (to);
if (!NILP (topos))
{
CHECK_CONS (topos);
CHECK_NUMBER_CAR (topos);
CHECK_NUMBER_CDR (topos);
CHECK_FIXNUM_CAR (topos);
CHECK_FIXNUM_CDR (topos);
}
if (!NILP (width))
CHECK_NUMBER (width);
CHECK_FIXNUM (width);
if (!NILP (offsets))
{
CHECK_CONS (offsets);
CHECK_NUMBER_CAR (offsets);
CHECK_NUMBER_CDR (offsets);
if (! (0 <= XINT (XCAR (offsets)) && XINT (XCAR (offsets)) <= PTRDIFF_MAX
&& 0 <= XINT (XCDR (offsets)) && XINT (XCDR (offsets)) <= INT_MAX))
CHECK_FIXNUM_CAR (offsets);
CHECK_FIXNUM_CDR (offsets);
if (! (0 <= XFIXNUM (XCAR (offsets)) && XFIXNUM (XCAR (offsets)) <= PTRDIFF_MAX
&& 0 <= XFIXNUM (XCDR (offsets)) && XFIXNUM (XCDR (offsets)) <= INT_MAX))
args_out_of_range (XCAR (offsets), XCDR (offsets));
hscroll = XINT (XCAR (offsets));
tab_offset = XINT (XCDR (offsets));
hscroll = XFIXNUM (XCAR (offsets));
tab_offset = XFIXNUM (XCDR (offsets));
}
else
hscroll = tab_offset = 0;
w = decode_live_window (window);
if (XINT (from) < BEGV || XINT (from) > ZV)
args_out_of_range_3 (from, make_number (BEGV), make_number (ZV));
if (XINT (to) < BEGV || XINT (to) > ZV)
args_out_of_range_3 (to, make_number (BEGV), make_number (ZV));
if (XFIXNUM (from) < BEGV || XFIXNUM (from) > ZV)
args_out_of_range_3 (from, make_fixnum (BEGV), make_fixnum (ZV));
if (XFIXNUM (to) < BEGV || XFIXNUM (to) > ZV)
args_out_of_range_3 (to, make_fixnum (BEGV), make_fixnum (ZV));
pos = compute_motion (XINT (from), CHAR_TO_BYTE (XINT (from)),
XINT (XCDR (frompos)),
XINT (XCAR (frompos)), 0,
XINT (to),
pos = compute_motion (XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)),
XFIXNUM (XCDR (frompos)),
XFIXNUM (XCAR (frompos)), 0,
XFIXNUM (to),
(NILP (topos)
? window_internal_height (w)
: XINT (XCDR (topos))),
: XFIXNUM (XCDR (topos))),
(NILP (topos)
? (window_body_width (w, 0)
- (
@ -1803,8 +1803,8 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */)
FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 :
#endif
1))
: XINT (XCAR (topos))),
(NILP (width) ? -1 : XINT (width)),
: XFIXNUM (XCAR (topos))),
(NILP (width) ? -1 : XFIXNUM (width)),
hscroll, tab_offset, w);
XSETFASTINT (bufpos, pos->bufpos);
@ -1831,8 +1831,8 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
register ptrdiff_t first;
ptrdiff_t lmargin = hscroll > 0 ? 1 - hscroll : 0;
ptrdiff_t selective
= (INTEGERP (BVAR (current_buffer, selective_display))
? clip_to_bounds (-1, XINT (BVAR (current_buffer, selective_display)),
= (FIXNUMP (BVAR (current_buffer, selective_display))
? clip_to_bounds (-1, XFIXNUM (BVAR (current_buffer, selective_display)),
PTRDIFF_MAX)
: !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0);
Lisp_Object window;
@ -1870,7 +1870,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
&& indented_beyond_p (prevline, bytepos, selective))
/* Watch out for newlines with `invisible' property.
When moving upward, check the newline before. */
|| (propval = Fget_char_property (make_number (prevline - 1),
|| (propval = Fget_char_property (make_fixnum (prevline - 1),
Qinvisible,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
@ -1920,7 +1920,7 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
&& indented_beyond_p (prevline, bytepos, selective))
/* Watch out for newlines with `invisible' property.
When moving downward, check the newline after. */
|| (propval = Fget_char_property (make_number (prevline),
|| (propval = Fget_char_property (make_fixnum (prevline),
Qinvisible,
text_prop_object),
TEXT_PROP_MEANS_INVISIBLE (propval))))
@ -2016,8 +2016,8 @@ numbers on display. */)
return make_float ((double) pixel_width / FRAME_COLUMN_WIDTH (f));
}
else if (!NILP (pixelwise))
return make_number (pixel_width);
return make_number (width);
return make_fixnum (pixel_width);
return make_fixnum (width);
}
/* In window W (derived from WINDOW), return x coordinate for column
@ -2045,8 +2045,8 @@ restore_window_buffer (Lisp_Object list)
wset_buffer (w, XCAR (list));
list = XCDR (list);
set_marker_both (w->pointm, w->contents,
XFASTINT (XCAR (list)),
XFASTINT (XCAR (XCDR (list))));
XFIXNAT (XCAR (list)),
XFIXNAT (XCAR (XCDR (list))));
}
DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 3, 0,
@ -2100,15 +2100,15 @@ whether or not it is currently displayed in some window. */)
lines = XCDR (lines);
}
CHECK_NUMBER (lines);
CHECK_FIXNUM (lines);
w = decode_live_window (window);
if (XBUFFER (w->contents) != current_buffer)
{
/* Set the window's buffer temporarily to the current buffer. */
Lisp_Object old = list4 (window, w->contents,
make_number (marker_position (w->pointm)),
make_number (marker_byte_position (w->pointm)));
make_fixnum (marker_position (w->pointm)),
make_fixnum (marker_byte_position (w->pointm)));
record_unwind_protect (restore_window_buffer, old);
wset_buffer (w, Fcurrent_buffer ());
set_marker_both (w->pointm, w->contents,
@ -2118,7 +2118,7 @@ whether or not it is currently displayed in some window. */)
if (noninteractive)
{
struct position pos;
pos = *vmotion (PT, PT_BYTE, XINT (lines), w);
pos = *vmotion (PT, PT_BYTE, XFIXNUM (lines), w);
SET_PT_BOTH (pos.bufpos, pos.bytepos);
it.vpos = pos.vpos;
}
@ -2128,7 +2128,7 @@ whether or not it is currently displayed in some window. */)
int first_x;
bool overshoot_handled = 0;
bool disp_string_at_start_p = 0;
ptrdiff_t nlines = XINT (lines);
ptrdiff_t nlines = XFIXNUM (lines);
int vpos_init = 0;
double start_col UNINIT;
int start_x UNINIT;
@ -2356,7 +2356,7 @@ whether or not it is currently displayed in some window. */)
bidi_unshelve_cache (itdata, 0);
}
return unbind_to (count, make_number (it.vpos));
return unbind_to (count, make_fixnum (it.vpos));
}

16
src/inotify.c
View file

@ -176,7 +176,7 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev)
{
Lisp_Object name;
uint32_t mask;
CONS_TO_INTEGER (Fnth (make_number (3), watch), uint32_t, mask);
CONS_TO_INTEGER (Fnth (make_fixnum (3), watch), uint32_t, mask);
if (! (mask & ev->mask))
return Qnil;
@ -194,7 +194,7 @@ inotifyevent_to_event (Lisp_Object watch, struct inotify_event const *ev)
mask_to_aspects (ev->mask),
name,
INTEGER_TO_CONS (ev->cookie)),
Fnth (make_number (2), watch));
Fnth (make_fixnum (2), watch));
}
/* Add a new watch to watch-descriptor WD watching FILENAME and using
@ -220,7 +220,7 @@ add_watch (int wd, Lisp_Object filename,
/* Assign a watch ID that is not already in use, by looking
for a gap in the existing sorted list. */
for (; ! NILP (XCDR (tail)); tail = XCDR (tail), id++)
if (!EQ (XCAR (XCAR (XCDR (tail))), make_number (id)))
if (!EQ (XCAR (XCAR (XCDR (tail))), make_fixnum (id)))
break;
if (MOST_POSITIVE_FIXNUM < id)
emacs_abort ();
@ -229,7 +229,7 @@ add_watch (int wd, Lisp_Object filename,
/* Insert the newly-assigned ID into the previously-discovered gap,
which is possibly at the end of the list. Inserting it there
keeps the list sorted. */
watch_id = make_number (id);
watch_id = make_fixnum (id);
watch = list4 (watch_id, filename, callback, mask);
XSETCDR (tail, Fcons (watch, XCDR (tail)));
@ -446,12 +446,12 @@ static bool
valid_watch_descriptor (Lisp_Object wd)
{
return (CONSP (wd)
&& (RANGED_INTEGERP (0, XCAR (wd), INT_MAX)
&& (RANGED_FIXNUMP (0, XCAR (wd), INT_MAX)
|| (CONSP (XCAR (wd))
&& RANGED_INTEGERP ((MOST_POSITIVE_FIXNUM >> 16) + 1,
&& RANGED_FIXNUMP ((MOST_POSITIVE_FIXNUM >> 16) + 1,
XCAR (XCAR (wd)), INT_MAX >> 16)
&& RANGED_INTEGERP (0, XCDR (XCAR (wd)), (1 << 16) - 1)))
&& NATNUMP (XCDR (wd)));
&& RANGED_FIXNUMP (0, XCDR (XCAR (wd)), (1 << 16) - 1)))
&& FIXNATP (XCDR (wd)));
}
DEFUN ("inotify-rm-watch", Finotify_rm_watch, Sinotify_rm_watch, 1, 1, 0,

Some files were not shown because too many files have changed in this diff Show more