diff --git a/ChangeLog b/ChangeLog index b3d94b5df10..c29a9856a02 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,102 @@ +2012-08-14 Paul Eggert + + Merge from gnulib, incorporating: + 2012-08-05 extern-inline: also ignore -Wmissing-declarations + +2012-08-10 Juanma Barranquero + + * lib/makefile.w32-in (STAT_TIME_H): New macro. + (FTOASTR_C, $(BLD)/stat-time.$(O), $(BLD)/timespec.$(O)) + ($(BLD)/u64.$(O)): Update dependencies. + +2012-08-10 Glenn Morris + + * configure.ac (DIRECTORY_SEP): Move here from src/lisp.h. + +2012-08-08 Dmitry Antipov + + * configure.ac (--disable-features): Rename to --without-all. + (OPTION_DEFAULT_ON): Change to use with_features. + * INSTALL: Fix description. + +2012-08-07 Dmitry Antipov + + * configure.ac: New option --disable-features. + (OPTION_DEFAULT_ON): Change to use enable_features. + * INSTALL: Explain --disable-features. + +2012-08-07 Glenn Morris + + * configure.ac: Require automake 1.11 (fairly arbitrarily). + * autogen.sh (automake_min): Get it from configure.ac. + +2012-08-06 Glenn Morris + + * configure.ac (BROKEN_GETWD) [unixware]: New define. + + * configure.ac (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Remove. + (PENDING_OUTPUT_COUNT): Absorb GNU_LIBRARY_PENDING_OUTPUT_COUNT. + (DISPNEW_NEEDS_STDIO_EXT): New define. + +2012-08-05 Michael Albinus + + * INSTALL: Explain how to completely disable D-Bus. (Bug#12112) + +2012-08-05 Ulrich Müller + + * configure.ac: Disable paxctl if binaries don't have a + PT_PAX_FLAGS program header. (Bug#11979) + +2012-08-03 Eli Zaretskii + + * lib/makefile.w32-in (GNULIBOBJS): Add $(BLD)/stat-time.$(O), + $(BLD)/timespec.$(O), and $(BLD)/u64.$(O). + (SHA512_H): Don't mention u64.h twice. + ($(BLD)/stat-time.$(O), ($(BLD)/timespec.$(O), ($(BLD)/u64.$(O)): + New targets. + +2012-08-03 Paul Eggert + + Merge from gnulib, incorporating: + 2012-08-02 stat-time, timespec, u64: support naive out-of-dir builds + +2012-08-02 YAMAMOTO Mitsuharu + + * lib/Makefile.am (DEFAULT_INCLUDES): Add -I$(top_srcdir)/lib for + out-of-tree build. + +2012-08-02 Glenn Morris + + * make-dist: Remove src/s. + + * lib/makefile.w32-in (MS_W32_H): Update for new ms-w32.h location. + +2012-08-02 Paul Eggert + + Merge from gnulib (Bug#12116), incorporating: + 2012-08-01 extern-inline: new module + 2012-08-01 stat-time, timespec, u64, utimens: use extern-inline + * lib/stat-time.c, lib/timespec.c, lib/u64.c, m4/extern-inline.m4: + New files. The new .c files are for instantiating extern inline + functions. + + Port to Solaris 8. + Without this change, 'configure' fails because the recently-added + wait3 prototype in config.h messes up later 'configure' tests. + Fix this problem by droping wait3 and WRETCODE, as they're + no longer needed on hosts that are current porting targets. + * configure.ac (wait3, WRETCODE): Remove, fixing a FIXME. + All uses changed to waitpid and WEXITSTATUS. + + Avoid needless autoheader after autogen.sh. + * src/stamp-h.in: Remove from bzr repository; no longer needed there. + * .bzrignore: Add it. + * autogen.sh: Create it. + +2012-08-01 Glenn Morris + + * configure.ac (DOS_NT, MSDOS): New system type templates. + 2012-08-01 Ulrich Müller * configure.ac (LIB_STANDARD, START_FILES) [FreeBSD]: diff --git a/INSTALL b/INSTALL index 7e29d18bb73..f0cf5d68db0 100644 --- a/INSTALL +++ b/INSTALL @@ -280,6 +280,12 @@ You can tell configure where to search for GTK by specifying `--with-pkg-config-prog=PATH' where PATH is the pathname to pkg-config. Note that GTK version 2.6 or newer is required for Emacs. +Emacs will autolaunch a D-Bus session bus, when the environment +variable DISPLAY is set, but no session bus is running. This might be +inconvenient for Emacs when running as daemon or running via a remote +ssh connection. In order to completely prevent the use of D-Bus, configure +Emacs with the options `--without-dbus --without-gconf --without-gsettings'. + The Emacs mail reader RMAIL is configured to be able to read mail from a POP3 server by default. Versions of the POP protocol older than POP3 are not supported. For Kerberos-authenticated POP add @@ -313,6 +319,22 @@ systems which support that. Use --without-sound to disable sound support. +Use --without-all if you want to build a small executable with the minimal +dependencies on external libraries, at the cost of disabling most of the +features that are normally enabled by default. Using --without-all is +equivalent to --without-sound --without-dbus --without-libotf +--without-selinux --without-xft --without-gsettings --without-gnutls +--without-rsvg --without-xml2 --without-gconf --without-imagemagick +--without-m17n-flt --without-jpeg --without-tiff --without-gif +--without-png --without-gpm. Note that --without-all leaves X support +enabled, and using the GTK2 or GTK3 toolkit creates a lot of library +dependencies. So if you want to build a small executable with very basic +X support, use --without-all --with-x-toolkit=no. For the smallest possible +executable without X, use --without-all --without-x. If you want to build +with just a few features enabled, you can combine --without-all with +--with-FEATURE. For example, you can use --without-all --with-dbus +to build with DBus support and nothing more. + Use --with-wide-int to implement Emacs values with the type 'long long', even on hosts where a narrower type would do. With this option, on a typical 32-bit host, Emacs integers have 62 bits instead of 30. diff --git a/INSTALL.BZR b/INSTALL.BZR index e98d742fb33..9ff6a73a1c5 100644 --- a/INSTALL.BZR +++ b/INSTALL.BZR @@ -9,7 +9,8 @@ when building from a release. You will need: autoconf - at least the version specified near the start of configure.ac (in the AC_PREREQ command). -automake - we recommend at least version 1.11. +automake - at least the version specified near the start of + configure.ac (in the AM_INIT_AUTOMAKE command). makeinfo - not strictly necessary, but highly recommended, so that you can build the manuals. diff --git a/README b/README index de4ee24fc5e..a11935ee3e8 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2012 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 24.1.50 of GNU Emacs, the extensible, +This directory tree holds version 24.2.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 47963edecab..34e4b3a3700 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -1,10 +1,21 @@ Here are some of the cpp macros used, together with some short explanation of their use. Feel free to add more macros and more categories. +Most of these are from config.in, so it's probably better to put the +explanations in that file. Ideally, everything would be defined and +documented in config.in, and this file would not be necessary. + ** Distinguishing OSes ** +AIX +_AIX +BSD4_2 +BSD_SYSTEM CYGWIN Compiling the Cygwin port. __CYGWIN__ Ditto +GNU_LINUX +HPUX +IRIX6_5 MSDOS Compiling the MS-DOS port. __MSDOS__ Ditto. __DJGPP_MINOR__ Minor version number of the DJGPP library; used only in msdos.c and dosfns.c. @@ -13,6 +24,10 @@ WINDOWSNT Compiling the native MS-Windows (W32) port. __MINGW32__ Compiling the W32 port with the MinGW port of GCC. _MSC_VER Compiling the W32 port with the Microsoft C compiler. DARWIN_OS Compiling on Mac OS X or pure Darwin (and using s/darwin.h). +SOLARIS2 +USG +USG5 +USG5_4 ** Distinguishing GUIs ** @@ -25,6 +40,9 @@ HAVE_X_WINDOWS Compile support for X Window system (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must be, and vice versa. At least, this is true for configure, and msdos; not sure about nt.) +HAVE_X11R6 +HAVE_X11R6_XIM +HAVE_X11XTR6 USE_LUCID Use the Lucid toolkit for menus&scrollbars. Requires HAVE_X11. USE_MOTIF Use the Motif toolkit for menus&scrollbars. Requires HAVE_X11. USE_GTK Use the Gtk toolkit for menus&scrollbars. Requires HAVE_X11. @@ -45,12 +63,12 @@ HAVE_PROCFS The /proc filesystem is supported. REL_ALLOC Compile in the relocatable memory allocator ralloc.c. SYSTEM_MALLOC Use the system library's malloc. -subprocesses System can use subprocesses (for M-x shell for example). Defined by default, only MSDOS undefines it. -DEBUG_LISP_OBJECT_TYPE Define it in lisp.h enable compile time checks on Lisp_Object use. +subprocesses System can use subprocesses (for M-x shell for example). + Defined by default, only MSDOS undefines it. +DEBUG_LISP_OBJECT_TYPE Define it in lisp.h enable compile time checks + on Lisp_Object use. -** System specific macros, described in detail in src/s/template.h -CLASH_DETECTION -COFF +** System specific macros FIRST_PTY_LETTER HAVE_PTYS INTERRUPT_INPUT @@ -59,15 +77,16 @@ SEPCHAR SYSTEM_TYPE ** Misc macros -USER_FULL_NAME If defined, overrides the default pw->pw_gecos for getting at the full user name. Only MSDOS overrides the default. +USER_FULL_NAME If defined, overrides the default pw->pw_gecos for +getting at the full user name. Only MSDOS overrides the default. -** Defines from src/s/*.h. Some of these might not be used in the code anymore, so they can be removed. The HAVE_* definitions are probably handled by autoconf, so it might be possible to just remove them from src/s/*.h. +** Miscellaneous defines. Some of these might not be used in the code +anymore, so they can be removed. - -AIX AMPERSAND_FULL_NAME BROKEN_DATAGRAM_SOCKETS BROKEN_FIONREAD +BROKEN_GETWD BROKEN_GET_CURRENT_DIR_NAME BROKEN_NON_BLOCKING_CONNECT BROKEN_PTY_READ_AFTER_EAGAIN @@ -76,105 +95,338 @@ BROKEN_SIGAIO BROKEN_SIGIO BROKEN_SIGPOLL BROKEN_SIGPTY -BSD4_2 -BSD_SYSTEM CLASH_DETECTION DATA_SEG_BITS DATA_START -DBL_MIN_REPLACEMENT DEFAULT_SOUND_DEVICE DEVICE_SEP DIRECTORY_SEP DONT_REOPEN_PTY DOUG_LEA_MALLOC -DebPrint -EMACSDEBUG EMACS_CONFIGURATION EMACS_CONFIG_OPTIONS EMACS_INT EMACS_UINT FLOAT_CHECK_DOMAIN -GC_LISP_OBJECT_ALIGNMENT GC_MARK_SECONDARY_STACK GC_MARK_STACK GC_SETJMP_WORKS -GMALLOC_INHIBIT_VALLOC -GNU_LIBRARY_PENDING_OUTPUT_COUNT -GNU_LINUX GNU_MALLOC HAVE_AIX_SMT_EXP +HAVE_ALARM +HAVE_ALLOCA +HAVE_ALLOCA_H +HAVE_ALSA +HAVE_ATTRIBUTE_ALIGNED +HAVE_BDFFONT +HAVE_BOXES +HAVE_C99_STRTOLD HAVE_CBRT +HAVE_CFMAKERAW +HAVE_CFSETSPEED +HAVE_CLOCK_GETTIME +HAVE_CLOCK_SETTIME HAVE_CLOSEDIR +HAVE_COFF_H +HAVE_COM_ERR_H +HAVE_COPYSIGN +HAVE_DBUS +HAVE_DBUS_TYPE_IS_VALID +HAVE_DBUS_VALIDATE_BUS_NAME +HAVE_DBUS_VALIDATE_INTERFACE +HAVE_DBUS_VALIDATE_MEMBER +HAVE_DBUS_VALIDATE_PATH +HAVE_DBUS_WATCH_GET_UNIX_FD +HAVE_DECL_GETENV +HAVE_DECL_LOCALTIME_R +HAVE_DECL_STRMODE +HAVE_DECL_STRTOIMAX +HAVE_DECL_STRTOLL +HAVE_DECL_STRTOULL +HAVE_DECL_STRTOUMAX +HAVE_DECL_SYS_SIGLIST +HAVE_DECL_TZNAME +HAVE_DECL___SYS_SIGLIST +HAVE_DES_H +HAVE_DEV_PTMX +HAVE_DIALOGS +HAVE_DIFFTIME +HAVE_DIRENT_H HAVE_DUP2 +HAVE_ENDGRENT +HAVE_ENDPWENT +HAVE_ENVIRON_DECL HAVE_EUIDACCESS +HAVE_FCNTL_H HAVE_FMOD +HAVE_FORK HAVE_FPATHCONF +HAVE_FREEIFADDRS +HAVE_FREETYPE HAVE_FREXP +HAVE_FSEEKO HAVE_FSYNC +HAVE_FUTIMENS +HAVE_FUTIMES +HAVE_FUTIMESAT +HAVE_GAI_STRERROR +HAVE_GCONF +HAVE_GETADDRINFO HAVE_GETCWD +HAVE_GETDELIM +HAVE_GETGRENT HAVE_GETHOSTNAME +HAVE_GETIFADDRS +HAVE_GETLINE HAVE_GETLOADAVG +HAVE_GETOPT_H +HAVE_GETOPT_LONG_ONLY HAVE_GETPAGESIZE +HAVE_GETPEERNAME HAVE_GETPT +HAVE_GETPWENT +HAVE_GETRLIMIT +HAVE_GETRUSAGE +HAVE_GETSOCKNAME HAVE_GETTIMEOFDAY HAVE_GETWD +HAVE_GET_CURRENT_DIR_NAME +HAVE_GHOSTSCRIPT +HAVE_GIF +HAVE_GNUTLS +HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY +HAVE_GNUTLS_CERTIFICATE_SET_VERIFY_FUNCTION +HAVE_GPM +HAVE_GRANTPT +HAVE_GSETTINGS +HAVE_GTK3 +HAVE_GTK_ADJUSTMENT_GET_PAGE_SIZE +HAVE_GTK_DIALOG_GET_ACTION_AREA +HAVE_GTK_FILE_SELECTION_NEW +HAVE_GTK_MAIN +HAVE_GTK_MULTIDISPLAY +HAVE_GTK_ORIENTABLE_SET_ORIENTATION +HAVE_GTK_WIDGET_GET_MAPPED +HAVE_GTK_WIDGET_GET_SENSITIVE +HAVE_GTK_WIDGET_GET_WINDOW +HAVE_GTK_WIDGET_SET_HAS_WINDOW +HAVE_GTK_WINDOW_SET_HAS_RESIZE_GRIP +HAVE_G_TYPE_INIT HAVE_H_ERRNO +HAVE_IFADDRS_H +HAVE_IMAGEMAGICK HAVE_INET_SOCKETS +HAVE_INTTYPES_H HAVE_INVERSE_HYPERBOLIC +HAVE_JPEG +HAVE_KERBEROSIV_DES_H +HAVE_KERBEROSIV_KRB_H +HAVE_KERBEROS_DES_H +HAVE_KERBEROS_KRB_H +HAVE_KRB5_ERROR_E_TEXT +HAVE_KRB5_ERROR_TEXT +HAVE_KRB5_H +HAVE_KRB_H +HAVE_LANGINFO_CODESET +HAVE_LIBCOM_ERR +HAVE_LIBCRYPTO +HAVE_LIBDES +HAVE_LIBDES425 +HAVE_LIBDGC +HAVE_LIBDNET +HAVE_LIBHESIOD +HAVE_LIBK5CRYPTO +HAVE_LIBKRB +HAVE_LIBKRB4 +HAVE_LIBKRB5 HAVE_LIBKSTAT -HAVE_LIMITS_H +HAVE_LIBLOCKFILE +HAVE_LIBM +HAVE_LIBMAIL +HAVE_LIBOTF +HAVE_LIBPERFSTAT +HAVE_LIBPNG_PNG_H +HAVE_LIBPTHREADS +HAVE_LIBRESOLV +HAVE_LIBSELINUX +HAVE_LIBXEXT +HAVE_LIBXML2 +HAVE_LIBXMU HAVE_LINUX_VERSION_H +HAVE_LOCALTIME_R +HAVE_LOCAL_SOCKETS HAVE_LOGB HAVE_LONG_FILE_NAMES +HAVE_LONG_LONG_INT HAVE_LRAND48 +HAVE_LSTAT +HAVE_LUTIMES +HAVE_M17N_FLT +HAVE_MACHINE_SOUNDCARD_H +HAVE_MACH_MACH_H +HAVE_MAGICKEXPORTIMAGEPIXELS +HAVE_MAGICKMERGEIMAGELAYERS +HAVE_MAILLOCK_H +HAVE_MALLOC_MALLOC_H +HAVE_MATHERR +HAVE_MBSTATE_T +HAVE_MEMCMP +HAVE_MEMMOVE +HAVE_MEMORY_H +HAVE_MEMSET HAVE_MENUS -HAVE_MKTIME +HAVE_MKSTEMP +HAVE_MMAP HAVE_MOUSE +HAVE_MULTILINGUAL_MENU +HAVE_NANOTIME +HAVE_NET_IF_DL_H +HAVE_NET_IF_H +HAVE_NLIST_H +HAVE_OTF_GET_VARIATION_GLYPHS +HAVE_PERSONALITY_LINUX32 +HAVE_PNG +HAVE_PNG_H +HAVE_POSIX_MEMALIGN +HAVE_PROCFS +HAVE_PSELECT HAVE_PSTAT_GETDYNAMIC +HAVE_PTHREAD +HAVE_PTHREAD_H +HAVE_PTHREAD_SIGMASK +HAVE_PTYS +HAVE_PTY_H HAVE_PWD_H HAVE_RANDOM +HAVE_READLINK +HAVE_READLINKAT +HAVE_RECVFROM HAVE_RES_INIT HAVE_RINT +HAVE_RSVG HAVE_SELECT +HAVE_SENDTO +HAVE_SEQPACKET +HAVE_SETITIMER HAVE_SETLOCALE HAVE_SETPGID HAVE_SETRLIMIT HAVE_SETSID +HAVE_SHARED_GAME_DIR HAVE_SHUTDOWN +HAVE_SIGNED_${GLTYPE} +HAVE_SIGNED_SIG_ATOMIC_T +HAVE_SIGNED_WCHAR_T +HAVE_SIGNED_WINT_T +HAVE_SIGSET_T +HAVE_SIZE_T +HAVE_SNPRINTF HAVE_SOCKETS HAVE_SOUND +HAVE_SOUNDCARD_H +HAVE_SPEED_T +HAVE_STDINT_H +HAVE_STDIO_EXT_H HAVE_STDLIB_H -HAVE_STRFTIME +HAVE_STLIB_H_1 +HAVE_STRINGS_H HAVE_STRING_H +HAVE_STRNCASECMP +HAVE_STRSIGNAL +HAVE_STRTOIMAX +HAVE_STRTOLL +HAVE_STRTOULL +HAVE_STRTOUMAX +HAVE_STRUCT_ERA_ENTRY +HAVE_STRUCT_IFREQ_IFR_ADDR +HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN +HAVE_STRUCT_IFREQ_IFR_BROADADDR +HAVE_STRUCT_IFREQ_IFR_FLAGS +HAVE_STRUCT_IFREQ_IFR_HWADDR +HAVE_STRUCT_IFREQ_IFR_NETMASK +HAVE_STRUCT_NLIST_N_UN_N_NAME +HAVE_STRUCT_STAT_ST_ATIMENSEC +HAVE_STRUCT_STAT_ST_ATIMESPEC_TV_NSEC +HAVE_STRUCT_STAT_ST_ATIM_ST__TIM_TV_NSEC +HAVE_STRUCT_STAT_ST_ATIM_TV_NSEC +HAVE_STRUCT_STAT_ST_BIRTHTIMENSEC +HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC +HAVE_STRUCT_STAT_ST_BIRTHTIM_TV_NSEC +HAVE_STRUCT_TIMEZONE +HAVE_STRUCT_TM_TM_ZONE HAVE_STRUCT_UTIMBUF +HAVE_ST_DM_MODE +HAVE_SYMLINK +HAVE_SYNC +HAVE_SYS_BITYPES_H +HAVE_SYS_INTTYPES_H +HAVE_SYS_LOADAVG_H +HAVE_SYS_PARAM_H +HAVE_SYS_RESOURCE_H HAVE_SYS_SELECT_H +HAVE_SYS_SOCKET_H +HAVE_SYS_SOUNDCARD_H +HAVE_SYS_STAT_H HAVE_SYS_SYSTEMINFO_H HAVE_SYS_TIMEB_H HAVE_SYS_TIME_H +HAVE_SYS_TYPES_H +HAVE_SYS_UN_H +HAVE_SYS_UTSNAME_H +HAVE_SYS_VLIMIT_H +HAVE_SYS_WAIT_H HAVE_TCATTR +HAVE_TERM_H +HAVE_TIFF +HAVE_TIMEVAL +HAVE_TM_GMTOFF HAVE_TM_ZONE +HAVE_TOUCHLOCK +HAVE_TZNAME HAVE_TZSET HAVE_UNISTD_H +HAVE_UNSIGNED_LONG_LONG_INT +HAVE_UTIL_H +HAVE_UTIMENSAT +HAVE_UTIMES HAVE_UTIME_H +HAVE_UTMP_H +HAVE_VFORK +HAVE_VFORK_H +HAVE_WCHAR_H +HAVE_WCHAR_T HAVE_WINDOW_SYSTEM +HAVE_WINSOCK2_H +HAVE_WORKING_FORK +HAVE_WORKING_UTIMES HAVE_WORKING_VFORK +HAVE_WS2TCPIP_H +HAVE_XAW3D +HAVE_XFT +HAVE_XIM +HAVE_XKBGETKEYBOARD +HAVE_XPM HAVE_XRMSETDATABASE -HPUX +HAVE_XSCREENNUMBEROFSCREEN +HAVE_XSCREENRESOURCESTRING +HAVE_X_I18N +HAVE_X_MENU +HAVE_X_SM +HAVE_X_WINDOWS +HAVE__BOOL +HAVE__FTIME +HAVE___BUILTIN_UNWIND_INIT +HAVE___EXECUTABLE_START +HAVE___FPENDING INTERNAL_TERMINAL IS_ANY_SEP IS_DIRECTORY_SEP -LINKER -LINUX_VERSION_CODE -LNOFLSH LOCALTIME_CACHE MAIL_USE_FLOCK MAIL_USE_LOCKF MAIL_USE_POP MAIL_USE_SYSTEM_LOCK MAXPATHLEN -MIN_PTY_KERNEL_VERSION -- only used on Mac -MODE_LINE_BINARY_TEXT -MUST_UNDEF__STDC__ NLIST_STRUCT NO_ABORT NO_EDITRES @@ -184,7 +436,6 @@ NSIG NSIG_MINIMUM NULL_DEVICE ORDINARY_LINK -O_APPEND O_RDONLY O_RDWR PAGESIZE @@ -197,7 +448,6 @@ PTY_TTY_NAME_SPRINTF PURESIZE RUN_TIME_REMAP SA_RESTART -SEGMENT_MASK SETPGRP_RELEASES_CTTY SETUP_SLAVE_PTY SIGALRM @@ -208,11 +458,9 @@ SIGNALS_VIA_CHARACTERS SIGPIPE SIGQUIT SIGTRAP -SOLARIS2 STDC_HEADERS SYSTEM_PURESIZE_EXTRA SYSTEM_MALLOC -SYSV_SYSTEM_DIR TAB3 TABDLY TERM @@ -221,101 +469,173 @@ TIOCSIGSEND TM_IN_SYS_TIME ULIMIT_BREAK_VALUE UNIX98_PTYS -USE_CRT_DLL USE_TOOLKIT_SCROLL_BARS -USG -USG5 USG_SUBTTY_WORKS VALBITS -WRETCODE XOS_NEEDS_TIME_H -_AIX -_ARCH_PPC64 _FILE_OFFSET_BITS _LP64 -_MALLOC_INTERNAL +_longjmp +_setjmp +abort +alloca +close +emacs +free +gmtime +localtime +malloc +random +read +realloc +select +umask +vfork + + +src/sysdep.c: +write + +src/syssignal.h: +signal +sigmask +sigsetmask + + +lib/dup2.c: +dup2 + +lib/signal.h: +signal + +lib/sigprocmask.c: +signal + +lib/stdio.h: +fdopen +fopen +fwrite +popen +rename + +lib/stdlib.h: +calloc +srandom (conf_post.h may undo) + +lib/strftime.c: +tzname +tzset + +lib/sys/stat.h: +mkdir + +lib/unistd.h: +chown +dup +dup2 +ftruncate +isatty +link +lseek +pipe +rmdir +sleep +unlink + + +MS DOS stuff: + _NAIVE_DOS_REGS + + +MS stuff: + +USE_CRT_DLL + +ms-w32.h: +DebPrint +EMACSDEBUG +MUST_UNDEF__STDC__ + _VARARGS_ _WINSOCKAPI_ _WINSOCK_H -_longjmp -_setjmp -_start -abort + access -alloca -brk calloc chdir chmod chown -close creat ctime dup dup2 -edata -emacs -etext execlp -execvp +execvp (also emacsclient.c [WINDOWSNT]) fdopen fileno fopen -free fsync ftruncate -fwrite getdefdir getdisk -getenv getpid -getuid -gmtime -index isatty kill link -linux -localtime logb lseek -malloc mkdir mktemp open pclose pipe popen -random -read -realloc rename -rindex rmdir -sbrk -select -sigmask signal -sigsetmask sleep spawnve -srandom strdup stricmp strnicmp strupr sys_nerr -system -temacs tzname tzset umask -unix unlink utimbuf utime -vfork -wait +wait (also movemail.c [WINDOWSNT]) write -xfree + +lib-src/ntlib: +access +chdir +chmod +creat +dup +dup2 +execlp +execvp +fdopen +fileno +fopen +getpid +index +isatty +logb +lseek +mkdir +mktemp +open +pclose +pipe +popen +rmdir +rindex +sleep +umask +unlink +utime diff --git a/admin/ChangeLog b/admin/ChangeLog index 54ac7b4edd7..c579930d2bf 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,23 @@ +2012-08-14 Paul Eggert + + Use bool for Emacs Lisp booleans. + * merge-gnulib (GNULIB_MODULES): Add stdbool. This documents a + new direct dependency; stdbool was already being used indirectly + via other gnulib modules. + +2012-08-11 Glenn Morris + + * bzrmerge.el (bzrmerge-resolve): Disable local eval:. + +2012-08-07 Dmitry Antipov + + * coccinelle/overlay.cocci, coccinelle/symbol.cocci: Remove. + +2012-08-02 Paul Eggert + + Port to Solaris 8. + * CPP-DEFINES (WRETCODE): Remove. + 2012-08-01 Dmitry Antipov * coccinelle/overlay.cocci: Semantic patch to replace direct diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index 86d319d65d5..34763083e9a 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -34,7 +34,6 @@ Eli Zaretskii src/msdos.[ch] src/dosfns.[ch] src/w16select.c - src/s/msdos.h lisp/term/internal.el lisp/term/pc-win.el lisp/dos-fns.el @@ -183,7 +182,6 @@ src/print.c src/process.c src/ralloc.c src/region-cache.c -src/s/ src/scroll.c src/search.c src/sound.c diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 977e95860e2..e174312143d 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -160,7 +160,8 @@ Type `y' to skip this revision, (unless (file-exists-p file) (error "Bzrmerge-resolve: Can't find %s" file)) (with-demoted-errors (let ((exists (find-buffer-visiting file))) - (with-current-buffer (let ((enable-local-variables :safe)) + (with-current-buffer (let ((enable-local-variables :safe) + (enable-local-eval nil)) (find-file-noselect file)) (if (buffer-modified-p) (error "Unsaved changes in %s" (current-buffer))) diff --git a/admin/coccinelle/overlay.cocci b/admin/coccinelle/overlay.cocci deleted file mode 100644 index 2be141e8332..00000000000 --- a/admin/coccinelle/overlay.cocci +++ /dev/null @@ -1,28 +0,0 @@ -// Change direct access to Lisp_Object fields of struct -// Lisp_Overlay to MVAR. Beginning M denotes "misc", and -// MVAR is likely to be used for other second-class objects. -@@ -struct Lisp_Overlay *V; -Lisp_Object O; -@@ -( -- V->start -+ MVAR (V, start) -| -- V->end -+ MVAR (V, end) -| -- V->plist -+ MVAR (V, plist) - -| - -- XOVERLAY (O)->start -+ MVAR (XOVERLAY (O), start) -| -- XOVERLAY (O)->end -+ MVAR (XOVERLAY (O), end) -| -- XOVERLAY (O)->plist -+ MVAR (XOVERLAY (O), plist) -) diff --git a/admin/coccinelle/symbol.cocci b/admin/coccinelle/symbol.cocci deleted file mode 100644 index c988fabc256..00000000000 --- a/admin/coccinelle/symbol.cocci +++ /dev/null @@ -1,32 +0,0 @@ -// Change direct access to Lisp_Object fields of struct Lisp_Symbol to SVAR. -@@ -struct Lisp_Symbol *S; -Lisp_Object O; -@@ -( -- S->xname -+ SVAR (S, xname) -| -- S->val.value -+ SVAR (S, val.value) -| -- S->function -+ SVAR (S, function) -| -- S->plist -+ SVAR (S, plist) - -| - -- XSYMBOL (O)->xname -+ SVAR (XSYMBOL (O), xname) -| -- XSYMBOL (O)->val.value -+ SVAR (XSYMBOL (O), val.value) -| -- XSYMBOL (O)->function -+ SVAR (XSYMBOL (O), function) -| -- XSYMBOL (O)->plist -+ SVAR (XSYMBOL (O), plist) -) diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 49d194c8033..c5b9eba5ee6 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -32,7 +32,7 @@ GNULIB_MODULES=' filemode getloadavg getopt-gnu gettime gettimeofday ignore-value intprops largefile lstat manywarnings mktime pselect pthread_sigmask readlink - socklen stat-time stdalign stdarg stdio + socklen stat-time stdalign stdarg stdbool stdio strftime strtoimax strtoumax symlink sys_stat sys_time time timespec-add timespec-sub utimens warnings diff --git a/autogen.sh b/autogen.sh index 0c92047e469..9cfaa40eee5 100755 --- a/autogen.sh +++ b/autogen.sh @@ -36,8 +36,9 @@ progs="autoconf automake" ## Minimum versions we need: autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac` -## FIXME how to determine this from the sources? -automake_min=1.11 +## This will need improving if more options are ever added to the +## AM_INIT_AUTOMAKE call. +automake_min=`sed -n 's/^ *AM_INIT_AUTOMAKE(\([0-9\.]*\)).*/\1/p' configure.ac` ## $1 = program, eg "autoconf". @@ -209,6 +210,10 @@ echo "Your system has the required tools, running autoreconf..." ## Let autoreconf figure out what, if anything, needs doing. autoreconf -i -I m4 || exit $? +## Create a timestamp, so that './autogen.sh; make' doesn't +## cause 'make' to needlessly run 'autoheader'. +echo timestamp > src/stamp-h.in || exit + echo "You can now run \`./configure'." exit 0 diff --git a/autogen/Makefile.in b/autogen/Makefile.in index bcaebd9e080..49dad9ea96d 100644 --- a/autogen/Makefile.in +++ b/autogen/Makefile.in @@ -66,9 +66,9 @@ am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/alloca.m4 $(top_srcdir)/m4/c-strtod.m4 \ $(top_srcdir)/m4/clock_time.m4 $(top_srcdir)/m4/dup2.m4 \ $(top_srcdir)/m4/environ.m4 $(top_srcdir)/m4/extensions.m4 \ - $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/getloadavg.m4 \ - $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gettime.m4 \ - $(top_srcdir)/m4/gettimeofday.m4 \ + $(top_srcdir)/m4/extern-inline.m4 $(top_srcdir)/m4/filemode.m4 \ + $(top_srcdir)/m4/getloadavg.m4 $(top_srcdir)/m4/getopt.m4 \ + $(top_srcdir)/m4/gettime.m4 $(top_srcdir)/m4/gettimeofday.m4 \ $(top_srcdir)/m4/gnulib-common.m4 \ $(top_srcdir)/m4/gnulib-comp.m4 \ $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/inttypes.m4 \ @@ -111,16 +111,17 @@ am__DEPENDENCIES_1 = am__libgnu_a_SOURCES_DIST = allocator.c c-ctype.h c-ctype.c \ c-strcase.h c-strcasecmp.c c-strncasecmp.c careadlinkat.c \ md5.c sha1.c sha256.c sha512.c dtoastr.c dtotimespec.c \ - filemode.c gettext.h gettime.c strftime.c timespec-add.c \ - timespec-sub.c utimens.c + filemode.c gettext.h gettime.c stat-time.c strftime.c \ + timespec.c timespec-add.c timespec-sub.c u64.c utimens.c am__objects_1 = am_libgnu_a_OBJECTS = allocator.$(OBJEXT) c-ctype.$(OBJEXT) \ c-strcasecmp.$(OBJEXT) c-strncasecmp.$(OBJEXT) \ careadlinkat.$(OBJEXT) md5.$(OBJEXT) sha1.$(OBJEXT) \ sha256.$(OBJEXT) sha512.$(OBJEXT) dtoastr.$(OBJEXT) \ dtotimespec.$(OBJEXT) filemode.$(OBJEXT) $(am__objects_1) \ - gettime.$(OBJEXT) strftime.$(OBJEXT) timespec-add.$(OBJEXT) \ - timespec-sub.$(OBJEXT) utimens.$(OBJEXT) + gettime.$(OBJEXT) stat-time.$(OBJEXT) strftime.$(OBJEXT) \ + timespec.$(OBJEXT) timespec-add.$(OBJEXT) \ + timespec-sub.$(OBJEXT) u64.$(OBJEXT) utimens.$(OBJEXT) libgnu_a_OBJECTS = $(am_libgnu_a_OBJECTS) depcomp = $(SHELL) $(top_srcdir)/build-aux/depcomp am__depfiles_maybe = depfiles @@ -874,12 +875,12 @@ MOSTLYCLEANFILES = core *.stackdump alloca.h alloca.h-t getopt.h \ time.h time.h-t unistd.h unistd.h-t noinst_LIBRARIES = libgnu.a AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) -DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src +DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src libgnu_a_SOURCES = allocator.c c-ctype.h c-ctype.c c-strcase.h \ c-strcasecmp.c c-strncasecmp.c careadlinkat.c md5.c sha1.c \ sha256.c sha512.c dtoastr.c dtotimespec.c filemode.c \ - $(am__append_1) gettime.c strftime.c timespec-add.c \ - timespec-sub.c utimens.c + $(am__append_1) gettime.c stat-time.c strftime.c timespec.c \ + timespec-add.c timespec-sub.c u64.c utimens.c libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) EXTRA_libgnu_a_SOURCES = ftoastr.c dup2.c getloadavg.c getopt.c \ @@ -968,6 +969,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha256.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sha512.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat-time.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stat.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strtoimax.Po@am__quote@ @@ -980,6 +982,8 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time_r.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-add.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec-sub.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/timespec.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/u64.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utimens.Po@am__quote@ .c.o: diff --git a/autogen/aclocal.m4 b/autogen/aclocal.m4 index 4d397b99b11..f7ef80bb805 100644 --- a/autogen/aclocal.m4 +++ b/autogen/aclocal.m4 @@ -991,6 +991,7 @@ m4_include([m4/clock_time.m4]) m4_include([m4/dup2.m4]) m4_include([m4/environ.m4]) m4_include([m4/extensions.m4]) +m4_include([m4/extern-inline.m4]) m4_include([m4/filemode.m4]) m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) diff --git a/autogen/config.in b/autogen/config.in index c330f6425a2..8e18d1c9206 100644 --- a/autogen/config.in +++ b/autogen/config.in @@ -53,6 +53,9 @@ along with GNU Emacs. If not, see . */ /* Define if FIONREAD should not be used. */ #undef BROKEN_FIONREAD +/* Define if getwd should not be used. */ +#undef BROKEN_GETWD + /* Define if get_current_dir_name should not be used. */ #undef BROKEN_GET_CURRENT_DIR_NAME @@ -123,11 +126,20 @@ along with GNU Emacs. If not, see . */ /* Define to 1 for DGUX with . */ #undef DGUX +/* Character that separates directories in a file name. */ +#undef DIRECTORY_SEP + +/* Define if dispnew.c should include stdio_ext.h. */ +#undef DISPNEW_NEEDS_STDIO_EXT + /* Define if process.c does not need to close a pty to make it a controlling terminal (it is already a controlling terminal of the subprocess, because we did ioctl TIOCSCTTY). */ #undef DONT_REOPEN_PTY +/* Define if the system is MS DOS or MS Windows. */ +#undef DOS_NT + /* Define to 1 if you are using the GNU C Library. */ #undef DOUG_LEA_MALLOC @@ -201,9 +213,6 @@ along with GNU Emacs. If not, see . */ whether the gnulib module scanf shall be considered present. */ #undef GNULIB_SCANF -/* Value of PENDING_OUTPUT_COUNT if using the GNU C library. */ -#undef GNU_LIBRARY_PENDING_OUTPUT_COUNT - /* Define if ths system is compatible with GNU/Linux. */ #undef GNU_LINUX @@ -1150,6 +1159,9 @@ along with GNU Emacs. If not, see . */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP +/* Define if the system is MS DOS. */ +#undef MSDOS + /* Define if system's imake configuration file defines `NeedWidePrototypes' as `NO'. */ #undef NARROWPROTO @@ -1416,9 +1428,6 @@ along with GNU Emacs. If not, see . */ # endif #endif -/* Some platforms redefine this. */ -#undef WRETCODE - /* Define this to check for malloc buffer overrun. */ #undef XMALLOC_OVERRUN_CHECK @@ -1530,6 +1539,36 @@ along with GNU Emacs. If not, see . */ configuration information. */ #undef config_opsysfile +/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'. + _GL_EXTERN_INLINE is a portable alternative to 'extern inline'. + _GL_INLINE_HEADER_BEGIN contains useful stuff to put + in an include file, before uses of _GL_INLINE. + It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic, + when FOO is an inline function in the header; see + . + _GL_INLINE_HEADER_END contains useful stuff to put + in the same include file, after uses of _GL_INLINE. */ +#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +# define _GL_INLINE inline +# define _GL_EXTERN_INLINE extern inline +# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# define _GL_INLINE_HEADER_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") +# define _GL_INLINE_HEADER_END \ + _Pragma ("GCC diagnostic pop") +# endif +#else +# define _GL_INLINE static inline +# define _GL_EXTERN_INLINE static inline +#endif + +#ifndef _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_END +#endif + /* A replacement for va_copy, if needed. */ #define gl_va_copy(a,b) ((a) = (b)) @@ -1632,9 +1671,6 @@ along with GNU Emacs. If not, see . */ /* Define as `fork' if `vfork' does not work. */ #undef vfork -/* Some platforms redefine this. */ -#undef wait3 - #include #endif /* EMACS_CONFIG_H */ diff --git a/autogen/configure b/autogen/configure index 919204c5da1..b7cee129757 100755 --- a/autogen/configure +++ b/autogen/configure @@ -1356,6 +1356,7 @@ lisp_frag ns_frag' ac_user_opts=' enable_option_checking +with_all with_pop with_kerberos with_kerberos5 @@ -2072,6 +2073,8 @@ Optional Features: Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --without-all omit almost all features and build small executable + with minimal dependencies --without-pop don't support POP mail retrieval with movemail --with-kerberos support Kerberos-authenticated POP --with-kerberos5 support Kerberos version 5 authenticated POP @@ -3998,13 +4001,22 @@ docdir='${datadir}/emacs/${version}/etc' gamedir='${localstatedir}/games/emacs' +# Check whether --with-all was given. +if test "${with_all+set}" = set; then : + withval=$with_all; with_features=$withval +else + with_features=yes +fi + + + # Check whether --with-pop was given. if test "${with_pop+set}" = set; then : withval=$with_pop; else - with_pop=yes + with_pop=$with_features fi if test "$with_pop" = yes; then @@ -4102,7 +4114,7 @@ fi if test "${with_sound+set}" = set; then : withval=$with_sound; else - with_sound=yes + with_sound=$with_features fi @@ -4111,7 +4123,7 @@ fi if test "${with_sync_input+set}" = set; then : withval=$with_sync_input; else - with_sync_input=yes + with_sync_input=$with_features fi if test "$with_sync_input" = yes; then @@ -4161,7 +4173,7 @@ fi if test "${with_xpm+set}" = set; then : withval=$with_xpm; else - with_xpm=yes + with_xpm=$with_features fi @@ -4169,7 +4181,7 @@ fi if test "${with_jpeg+set}" = set; then : withval=$with_jpeg; else - with_jpeg=yes + with_jpeg=$with_features fi @@ -4177,7 +4189,7 @@ fi if test "${with_tiff+set}" = set; then : withval=$with_tiff; else - with_tiff=yes + with_tiff=$with_features fi @@ -4185,7 +4197,7 @@ fi if test "${with_gif+set}" = set; then : withval=$with_gif; else - with_gif=yes + with_gif=$with_features fi @@ -4193,7 +4205,7 @@ fi if test "${with_png+set}" = set; then : withval=$with_png; else - with_png=yes + with_png=$with_features fi @@ -4201,7 +4213,7 @@ fi if test "${with_rsvg+set}" = set; then : withval=$with_rsvg; else - with_rsvg=yes + with_rsvg=$with_features fi @@ -4209,7 +4221,7 @@ fi if test "${with_xml2+set}" = set; then : withval=$with_xml2; else - with_xml2=yes + with_xml2=$with_features fi @@ -4217,7 +4229,7 @@ fi if test "${with_imagemagick+set}" = set; then : withval=$with_imagemagick; else - with_imagemagick=yes + with_imagemagick=$with_features fi @@ -4226,7 +4238,7 @@ fi if test "${with_xft+set}" = set; then : withval=$with_xft; else - with_xft=yes + with_xft=$with_features fi @@ -4234,7 +4246,7 @@ fi if test "${with_libotf+set}" = set; then : withval=$with_libotf; else - with_libotf=yes + with_libotf=$with_features fi @@ -4242,7 +4254,7 @@ fi if test "${with_m17n_flt+set}" = set; then : withval=$with_m17n_flt; else - with_m17n_flt=yes + with_m17n_flt=$with_features fi @@ -4251,7 +4263,7 @@ fi if test "${with_toolkit_scroll_bars+set}" = set; then : withval=$with_toolkit_scroll_bars; else - with_toolkit_scroll_bars=yes + with_toolkit_scroll_bars=$with_features fi @@ -4259,7 +4271,7 @@ fi if test "${with_xaw3d+set}" = set; then : withval=$with_xaw3d; else - with_xaw3d=yes + with_xaw3d=$with_features fi @@ -4267,7 +4279,7 @@ fi if test "${with_xim+set}" = set; then : withval=$with_xim; else - with_xim=yes + with_xim=$with_features fi @@ -4284,7 +4296,7 @@ fi if test "${with_gpm+set}" = set; then : withval=$with_gpm; else - with_gpm=yes + with_gpm=$with_features fi @@ -4292,7 +4304,7 @@ fi if test "${with_dbus+set}" = set; then : withval=$with_dbus; else - with_dbus=yes + with_dbus=$with_features fi @@ -4300,15 +4312,26 @@ fi if test "${with_gconf+set}" = set; then : withval=$with_gconf; else - with_gconf=yes + with_gconf=$with_features fi +<<<<<<< TREE +======= +# Check whether --with-gsettings was given. +if test "${with_gsettings+set}" = set; then : + withval=$with_gsettings; +else + with_gsettings=$with_features +fi + + +>>>>>>> MERGE-SOURCE # Check whether --with-selinux was given. if test "${with_selinux+set}" = set; then : withval=$with_selinux; else - with_selinux=yes + with_selinux=$with_features fi @@ -4316,7 +4339,7 @@ fi if test "${with_gnutls+set}" = set; then : withval=$with_gnutls; else - with_gnutls=yes + with_gnutls=$with_features fi @@ -4327,7 +4350,7 @@ fi if test "${with_makeinfo+set}" = set; then : withval=$with_makeinfo; else - with_makeinfo=yes + with_makeinfo=$with_features fi @@ -4338,7 +4361,7 @@ fi if test "${with_compress_info+set}" = set; then : withval=$with_compress_info; else - with_compress_info=yes + with_compress_info=$with_features fi if test $with_compress_info = yes; then @@ -7125,6 +7148,7 @@ esac # Code from module environ: # Code from module extensions: + # Code from module extern-inline: # Code from module filemode: # Code from module getloadavg: # Code from module getopt-gnu: @@ -7998,7 +8022,34 @@ $as_echo "no" >&6; } fi +<<<<<<< TREE +======= + if test "X$PAXCTL" != X; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether binaries have a PT_PAX_FLAGS header" >&5 +$as_echo_n "checking whether binaries have a PT_PAX_FLAGS header... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; }; PAXCTL=""; fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi +fi +>>>>>>> MERGE-SOURCE ## Need makeinfo >= 4.7 (?) to build the manuals. # Extract the first word of "makeinfo", so it can be a program name with args. @@ -13453,7 +13504,11 @@ fi done -if test $opsys != unixware; then +if test $opsys = unixware; then + +$as_echo "#define BROKEN_GETWD 1" >>confdefs.h + +else for ac_func in getwd do : ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd" @@ -15124,6 +15179,10 @@ $as_echo "#define USER_FULL_NAME pw->pw_gecos" >>confdefs.h +$as_echo "#define DIRECTORY_SEP '/'" >>confdefs.h + + + $as_echo "#define IS_DEVICE_SEP(_c_) 0" >>confdefs.h @@ -15231,35 +15290,35 @@ esac case $opsys in aix4-2 ) - $as_echo "#define PTY_ITERATION int c; for (c = 0; !c ; c++) " >>confdefs.h + $as_echo "#define PTY_ITERATION int c; for (c = 0; !c ; c++)" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptc\"); " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptc\");" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd)); " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF strcpy (pty_name, ttyname (fd));" >>confdefs.h ;; cygwin ) - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++) " >>confdefs.h + $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - $as_echo "#define PTY_OPEN do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0) " >>confdefs.h + $as_echo "#define PTY_OPEN do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0)" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h ;; darwin ) - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++) " >>confdefs.h + $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - $as_echo "#define PTY_OPEN do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0) " >>confdefs.h + $as_echo "#define PTY_OPEN do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h ;; @@ -15273,17 +15332,17 @@ case $opsys in $as_echo "#define UNIX98_PTYS 1" >>confdefs.h - $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++) " >>confdefs.h + $as_echo "#define PTY_ITERATION int i; for (i = 0; i < 1; i++)" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); sigunblock (sigmask (SIGCHLD)); } " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); sigunblock (sigmask (SIGCHLD)); }" >>confdefs.h if test "x$ac_cv_func_getpt" = xyes; then $as_echo "#define PTY_OPEN fd = getpt ()" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h else - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\"); " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h fi else @@ -15295,9 +15354,9 @@ $as_echo "#define UNIX98_PTYS 1" >>confdefs.h hpux*) $as_echo "#define FIRST_PTY_LETTER 'p'" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF sprintf (pty_name, \"/dev/ptym/pty%c%x\", c, i); " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF sprintf (pty_name, \"/dev/ptym/pty%c%x\", c, i);" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF sprintf (pty_name, \"/dev/pty/tty%c%x\", c, i); " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF sprintf (pty_name, \"/dev/pty/tty%c%x\", c, i);" >>confdefs.h ;; @@ -15306,21 +15365,21 @@ $as_echo "#define UNIX98_PTYS 1" >>confdefs.h $as_echo "#define FIRST_PTY_LETTER 'q'" >>confdefs.h - $as_echo "#define PTY_OPEN { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); } " >>confdefs.h + $as_echo "#define PTY_OPEN { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF /**/" >>confdefs.h - $as_echo "#define PTY_TTY_NAME_SPRINTF " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF /**/" >>confdefs.h ;; sol2* ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); } " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h ;; unixware ) - $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal(\"could not grant slave pty\"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal(\"could not unlock slave pty\"); if (!(ptyname = ptsname(fd))) fatal (\"could not enable slave pty\"); snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); } " >>confdefs.h + $as_echo "#define PTY_TTY_NAME_SPRINTF { char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal(\"could not grant slave pty\"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal(\"could not unlock slave pty\"); if (!(ptyname = ptsname(fd))) fatal (\"could not enable slave pty\"); snprintf (pty_name, sizeof pty_name, \"%s\", ptyname); }" >>confdefs.h ;; esac @@ -15330,7 +15389,7 @@ case $opsys in sol2* | unixware ) $as_echo "#define FIRST_PTY_LETTER 'z'" >>confdefs.h - $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\"); " >>confdefs.h + $as_echo "#define PTY_NAME_SPRINTF strcpy (pty_name, \"/dev/ptmx\");" >>confdefs.h $as_echo "#define SETUP_SLAVE_PTY if (ioctl (xforkin, I_PUSH, \"ptem\") == -1) fatal (\"ioctl I_PUSH ptem\"); if (ioctl (xforkin, I_PUSH, \"ldterm\") == -1) fatal (\"ioctl I_PUSH ldterm\"); if (ioctl (xforkin, I_PUSH, \"ttcompat\") == -1) fatal (\"ioctl I_PUSH ttcompat\");" >>confdefs.h @@ -15384,23 +15443,42 @@ esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C library" >&5 +$as_echo_n "checking whether we are using the GNU C library... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#ifndef __GNU_LIBRARY__ +# error "this is not the GNU C library" +#endif -case $opsys in - cygwin | darwin | freebsd | netbsd | openbsd ) - $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)" >>confdefs.h +int +main () +{ - ;; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + emacs_glibc=yes +else + emacs_glibc=no +fi +rm -f conftest.err conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $emacs_glibc" >&5 +$as_echo "$emacs_glibc" >&6; } - unixware) - $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)" >>confdefs.h +if test $emacs_glibc = yes; then - ;; + emacs_pending_output=unknown - gnu | gnu-linux | gnu-kfreebsd ) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of pending output formalism" >&5 + case $opsys in + gnu | gnu-linux | gnu-kfreebsd ) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of pending output formalism" >&5 $as_echo_n "checking for style of pending output formalism... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include @@ -15418,8 +15496,6 @@ main () _ACEOF if ac_fn_c_try_cpp "$LINENO"; then : emacs_pending_output=new -else - emacs_pending_output=unknown fi rm -f conftest.err conftest.$ac_ext @@ -15457,21 +15533,52 @@ $as_echo "$emacs_pending_output" >&6; } case $emacs_pending_output in new) - $as_echo "#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)" >>confdefs.h + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)" >>confdefs.h ;; uclibc) - $as_echo "#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufpos - (FILE)->__bufstart)" >>confdefs.h + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufpos - (FILE)->__bufstart)" >>confdefs.h ;; old) - $as_echo "#define GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE) ((FILE)->_pptr - (FILE)->_pbase)" >>confdefs.h + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_pptr - (FILE)->_pbase)" >>confdefs.h ;; esac ;; -esac + esac + if test $emacs_pending_output = unknown; then + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer)" >>confdefs.h + fi + +else + case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base)" >>confdefs.h + + ;; + + unixware) + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base)" >>confdefs.h + + ;; + + *) + if test x$ac_cv_header_stdio_ext_h = xyes && \ + test x$ac_cv_func___fpending = xyes; then + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE)" >>confdefs.h + + +$as_echo "#define DISPNEW_NEEDS_STDIO_EXT 1" >>confdefs.h + + else + $as_echo "#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)" >>confdefs.h + + fi + ;; + esac +fi @@ -15640,17 +15747,6 @@ $as_echo "#define TIOCSIGSEND TIOCSIGNAL" >>confdefs.h ;; esac -case $opsys in - irix6-5 | sol2* | unixware ) - -$as_echo "#define wait3(status, options, rusage) waitpid ((pid_t) -1, (status), (options))" >>confdefs.h - - -$as_echo "#define WRETCODE(w) (w >> 8)" >>confdefs.h - - ;; -esac - case $opsys in hpux* | sol2* ) @@ -15673,6 +15769,8 @@ esac + + case $opsys in aix4-2) $as_echo "#define USG /**/" >>confdefs.h @@ -16769,6 +16867,10 @@ $as_echo "#define HAVE_ENVIRON_DECL 1" >>confdefs.h HAVE_DECL_ENVIRON=0 fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 $as_echo_n "checking for st_dm_mode in struct stat... " >&6; } if test "${ac_cv_struct_st_dm_mode+set}" = set; then : @@ -19687,6 +19789,7 @@ fi + # Persuade glibc to declare getloadavg(). @@ -22317,6 +22420,11 @@ fi +<<<<<<< TREE +======= + + +>>>>>>> MERGE-SOURCE if test $gl_cv_have_include_next = yes; then gl_cv_next_unistd_h='<'unistd.h'>' else diff --git a/configure.ac b/configure.ac index 2c2c678c6dd..2b7e480e207 100644 --- a/configure.ac +++ b/configure.ac @@ -22,11 +22,12 @@ dnl You should have received a copy of the GNU General Public License dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) -AC_INIT(emacs, 24.1.50) +AC_INIT(emacs, 24.2.50) AC_CONFIG_HEADER(src/config.h:src/config.in) AC_CONFIG_SRCDIR(src/lisp.h) AC_CONFIG_AUX_DIR(build-aux) -AM_INIT_AUTOMAKE +dnl Fairly arbitrary, older versions might work too. +AM_INIT_AUTOMAKE(1.11) dnl Support for --program-prefix, --program-suffix and dnl --program-transform-name options @@ -47,6 +48,14 @@ archlibdir='${libexecdir}/emacs/${version}/${configuration}' docdir='${datadir}/emacs/${version}/etc' gamedir='${localstatedir}/games/emacs' +dnl Special option to disable the most of other options. +AC_ARG_WITH(all, +[AS_HELP_STRING([--without-all], + [omit almost all features and build + small executable with minimal dependencies])], + with_features=$withval, + with_features=yes) + dnl OPTION_DEFAULT_OFF(NAME, HELP-STRING) dnl Create a new --with option that defaults to being disabled. dnl NAME is the base name of the option. The shell variable with_NAME @@ -62,8 +71,8 @@ AC_DEFUN([OPTION_DEFAULT_OFF], [dnl ])dnl dnl OPTION_DEFAULT_ON(NAME, HELP-STRING) -dnl Create a new --with option that defaults to being enabled. NAME -dnl is the base name of the option. The shell variable with_NAME +dnl Create a new --with option that defaults to $enable_features. +dnl NAME is the base name of the option. The shell variable with_NAME dnl will be set either to 'no' (for a plain --without-NAME) or to dnl 'yes' (if the option is not specified). Note that the shell dnl variable name is constructed as autoconf does, by replacing @@ -71,7 +80,7 @@ dnl non-alphanumeric characters with "_". dnl HELP-STRING is the help text for the option. AC_DEFUN([OPTION_DEFAULT_ON], [dnl AC_ARG_WITH([$1],[AS_HELP_STRING([--without-$1],[$2])],[],[dnl - m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=yes])dnl + m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=$with_features])dnl ])dnl OPTION_DEFAULT_ON([pop],[don't support POP mail retrieval with movemail]) @@ -733,6 +742,12 @@ AC_PATH_PROG(GZIP_PROG, gzip) if test $opsys = gnu-linux; then AC_PATH_PROG(PAXCTL, paxctl,, [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) + if test "X$PAXCTL" != X; then + AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], + [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then AC_MSG_RESULT(yes) + else AC_MSG_RESULT(no); PAXCTL=""; fi]) + fi fi ## Need makeinfo >= 4.7 (?) to build the manuals. @@ -2779,10 +2794,11 @@ getpwent endpwent getgrent endgrent \ touchlock \ cfmakeraw cfsetspeed copysign __executable_start) -dnl FIXME Fragile: something else may test for getwd as a dependency. -dnl Change to defining BROKEN_xxx ? dnl getwd appears to be buggy on SVR4.2, so we don't use it. -if test $opsys != unixware; then +if test $opsys = unixware; then + dnl In case some other test ends up checking for getwd. + AC_DEFINE(BROKEN_GETWD, 1, [Define if getwd should not be used.]) +else AC_CHECK_FUNCS(getwd) fi @@ -3227,6 +3243,9 @@ AC_DEFINE(subprocesses, 1, [Define to enable asynchronous subprocesses.]) AC_DEFINE(USER_FULL_NAME, [pw->pw_gecos], [How to get a user's full name.]) +AC_DEFINE(DIRECTORY_SEP, ['/'], + [Character that separates directories in a file name.]) + dnl Only used on MS platforms. AH_TEMPLATE(DEVICE_SEP, [Character that separates a device in a file name.]) @@ -3424,31 +3443,31 @@ AH_TEMPLATE(PTY_TTY_NAME_SPRINTF, [How to get device name of the tty case $opsys in aix4-2 ) - AC_DEFINE(PTY_ITERATION, [int c; for (c = 0; !c ; c++)] ) + AC_DEFINE(PTY_ITERATION, [int c; for (c = 0; !c ; c++)]) dnl You allocate a pty by opening /dev/ptc to get the master side. dnl To get the name of the slave side, you just ttyname() the master side. - AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptc");] ) - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [strcpy (pty_name, ttyname (fd));] ) + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptc");]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [strcpy (pty_name, ttyname (fd));]) ;; cygwin ) - AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl multi-line AC_DEFINEs are hard. :( - AC_DEFINE(PTY_OPEN, [ do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0)] ) - AC_DEFINE(PTY_NAME_SPRINTF, [] ) - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_OPEN, [ do { int dummy; SIGMASKTYPE mask; mask = sigblock (sigmask (SIGCHLD)); if (-1 == openpty (&fd, &dummy, pty_name, 0, 0)) fd = -1; sigsetmask (mask); if (fd >= 0) emacs_close (dummy); } while (0)]) + AC_DEFINE(PTY_NAME_SPRINTF, []) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, []) ;; darwin ) - AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl Not used, because PTY_ITERATION is defined. AC_DEFINE(FIRST_PTY_LETTER, ['p']) dnl Note that openpty may fork via grantpt on Mac OS X 10.4/Darwin 8. dnl But we don't have to block SIGCHLD because it is blocked in the dnl implementation of grantpt. - AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)] ) - AC_DEFINE(PTY_NAME_SPRINTF, [] ) - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_OPEN, [ do { int slave; if (openpty (&fd, &slave, pty_name, NULL, NULL) == -1) fd = -1; else emacs_close (slave); } while (0)]) + AC_DEFINE(PTY_NAME_SPRINTF, []) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, []) ;; gnu | freebsd | netbsd | openbsd ) @@ -3459,16 +3478,16 @@ case $opsys in dnl if HAVE_GRANTPT if test "x$ac_cv_func_grantpt" = xyes; then AC_DEFINE(UNIX98_PTYS, 1, [Define if the system has Unix98 PTYs.]) - AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)] ) + AC_DEFINE(PTY_ITERATION, [int i; for (i = 0; i < 1; i++)]) dnl Note that grantpt and unlockpt may fork. We must block SIGCHLD dnl to prevent sigchld_handler from intercepting the child's death. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); sigunblock (sigmask (SIGCHLD)); }] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptyname; sigblock (sigmask (SIGCHLD)); if (grantpt (fd) == -1 || unlockpt (fd) == -1 || !(ptyname = ptsname(fd))) { sigunblock (sigmask (SIGCHLD)); close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); sigunblock (sigmask (SIGCHLD)); }]) dnl if HAVE_GETPT if test "x$ac_cv_func_getpt" = xyes; then AC_DEFINE(PTY_OPEN, [fd = getpt ()]) - AC_DEFINE(PTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_NAME_SPRINTF, []) else - AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");] ) + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");]) fi else AC_DEFINE(FIRST_PTY_LETTER, ['p']) @@ -3477,8 +3496,8 @@ case $opsys in hpux*) AC_DEFINE(FIRST_PTY_LETTER, ['p']) - AC_DEFINE(PTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);] ) - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);] ) + AC_DEFINE(PTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/ptym/pty%c%x", c, i);]) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);]) ;; irix6-5 ) @@ -3495,11 +3514,11 @@ case $opsys in AC_DEFINE(PTY_ITERATION, []) dnl Not used, because PTY_ITERATION is defined. AC_DEFINE(FIRST_PTY_LETTER, ['q']) - AC_DEFINE(PTY_OPEN, [ { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }] ) + AC_DEFINE(PTY_OPEN, [ { struct sigaction ocstat, cstat; struct stat stb; char * name; sigemptyset(&cstat.sa_mask); cstat.sa_handler = SIG_DFL; cstat.sa_flags = 0; sigaction(SIGCLD, &cstat, &ocstat); name = _getpty (&fd, O_RDWR | O_NDELAY, 0600, 0); sigaction(SIGCLD, &ocstat, (struct sigaction *)0); if (name == 0) return -1; if (fd < 0) return -1; if (fstat (fd, &stb) < 0) return -1; strcpy (pty_name, name); }]) dnl No need to get the pty name at all. - AC_DEFINE(PTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_NAME_SPRINTF, []) dnl No need to use sprintf to get the tty name--we get that from _getpty. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, []) ;; sol2* ) @@ -3509,12 +3528,12 @@ case $opsys in dnl On SysVr4, grantpt(3) forks a subprocess, so keep sigchld_handler() dnl from intercepting that death. If any child but grantpt's should die dnl within, it should be caught after sigrelse(2). - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock (sigmask (SIGCLD)); if (grantpt (fd) == -1) { emacs_close (fd); return -1; } sigunblock (sigmask (SIGCLD)); if (unlockpt (fd) == -1) { emacs_close (fd); return -1; } if (!(ptyname = ptsname (fd))) { emacs_close (fd); return -1; } snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) ;; unixware ) dnl Comments are as per sol2*. - AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal("could not grant slave pty"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }] ) + AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; sigblock(sigmask(SIGCLD)); if (grantpt(fd) == -1) fatal("could not grant slave pty"); sigunblock(sigmask(SIGCLD)); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, sizeof pty_name, "%s", ptyname); }]) ;; esac @@ -3524,7 +3543,7 @@ case $opsys in dnl This change means that we don't loop through allocate_pty too dnl many times in the (rare) event of a failure. AC_DEFINE(FIRST_PTY_LETTER, ['z']) - AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");] ) + AC_DEFINE(PTY_NAME_SPRINTF, [strcpy (pty_name, "/dev/ptmx");]) dnl Push various streams modules onto a PTY channel. Used in process.c. AC_DEFINE(SETUP_SLAVE_PTY, [if (ioctl (xforkin, I_PUSH, "ptem") == -1) fatal ("ioctl I_PUSH ptem"); if (ioctl (xforkin, I_PUSH, "ldterm") == -1) fatal ("ioctl I_PUSH ldterm"); if (ioctl (xforkin, I_PUSH, "ttcompat") == -1) fatal ("ioctl I_PUSH ttcompat");], [How to set up a slave PTY, if needed.]) ;; @@ -3561,31 +3580,32 @@ esac dnl Used in dispnew.c AH_TEMPLATE(PENDING_OUTPUT_COUNT, [Number of chars of output in the -buffer of a stdio stream.]) + buffer of a stdio stream.]) -dnl FIXME just PENDING_OUTPUT_COUNT should suffice. -AH_TEMPLATE(GNU_LIBRARY_PENDING_OUTPUT_COUNT, [Value of -PENDING_OUTPUT_COUNT if using the GNU C library.]) +AC_MSG_CHECKING([whether we are using the GNU C library]) +AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ +#include +#ifndef __GNU_LIBRARY__ +# error "this is not the GNU C library" +#endif + ]], [[]])], emacs_glibc=yes, emacs_glibc=no) +AC_MSG_RESULT([$emacs_glibc]) -case $opsys in - cygwin | darwin | freebsd | netbsd | openbsd ) - AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) - ;; +if test $emacs_glibc = yes; then - unixware) - AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) - ;; + emacs_pending_output=unknown - gnu | gnu-linux | gnu-kfreebsd ) - AC_MSG_CHECKING([for style of pending output formalism]) - dnl In autoconf 2.67 and later, we could use a single test - dnl since the preprocessed output is accessible in "conftest.i". - AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ + case $opsys in + gnu | gnu-linux | gnu-kfreebsd ) + AC_MSG_CHECKING([for style of pending output formalism]) + dnl In autoconf 2.67 and later, we could use a single test + dnl since the preprocessed output is accessible in "conftest.i". + AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ #include #if !defined (_IO_STDIO_H) && !defined (_STDIO_USES_IOSTREAM) # error "stdio definitions not found" #endif - ]], [[]])], emacs_pending_output=new, emacs_pending_output=unknown) + ]], [[]])], emacs_pending_output=new, []) if test $emacs_pending_output = unknown; then case $opsys in @@ -3605,22 +3625,51 @@ case $opsys in case $emacs_pending_output in new) dnl New C libio names. - AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_IO_write_ptr - (FILE)->_IO_write_base)]) ;; uclibc) dnl Using the uClibc library. - AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__bufpos - (FILE)->__bufstart)]) ;; old) dnl Old C++ iostream names. - AC_DEFINE(GNU_LIBRARY_PENDING_OUTPUT_COUNT(FILE), + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_pptr - (FILE)->_pbase)]) ;; esac ;; -esac + esac dnl opsys + + if test $emacs_pending_output = unknown; then + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__bufp - (FILE)->__buffer)]) + fi + +else dnl !emacs_glibc + + case $opsys in + cygwin | darwin | freebsd | netbsd | openbsd ) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_p - (FILE)->_bf._base)]) + ;; + + unixware) + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->__ptr - (FILE)->__base)]) + ;; + + *) + dnl HAVE_STDIO_EXT_H && HAVE___FPENDING + if test x$ac_cv_header_stdio_ext_h = xyes && \ + test x$ac_cv_func___fpending = xyes; then + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [__fpending (FILE)]) + AC_DEFINE(DISPNEW_NEEDS_STDIO_EXT, 1, + [Define if dispnew.c should include stdio_ext.h.]) + else + AC_DEFINE(PENDING_OUTPUT_COUNT(FILE), [((FILE)->_ptr - (FILE)->_base)]) + fi + ;; + esac +fi dnl emacs_glibc dnl Used in vm-limit.c @@ -3657,7 +3706,7 @@ case $opsys in darwin) AC_DEFINE(TAB3, OXTABS) ;; gnu | freebsd | netbsd | openbsd ) - AC_DEFINE(TABDLY, OXTABS, [Undocumented.] ) + AC_DEFINE(TABDLY, OXTABS, [Undocumented.]) AC_DEFINE(TAB3, OXTABS) ;; @@ -3753,23 +3802,6 @@ case $opsys in ;; esac -dnl Used in process.c. -case $opsys in - irix6-5 | sol2* | unixware ) - dnl It is possible to receive SIGCHLD when there are no children - dnl waiting, because a previous waitsys(2) cleaned up the carcass - dnl of child without clearing the SIGCHLD pending info. So, use a - dnl non-blocking wait3 instead, which maps to waitpid(2) in SysVr4. - AC_DEFINE(wait3(status, options, rusage), - [waitpid ((pid_t) -1, (status), (options))], - [Some platforms redefine this.]) - dnl FIXME this makes no sense, because WRETCODE is only used in - dnl process.c, which includes syswait.h aftet config.h, and the - dnl former unconditionally redefines WRETCODE. - AC_DEFINE(WRETCODE(w), [(w >> 8)], [Some platforms redefine this.]) - ;; -esac - case $opsys in hpux* | sol2* ) @@ -3791,6 +3823,8 @@ dnl Define symbols to identify the version of Unix this is. dnl Define all the symbols that apply correctly. AH_TEMPLATE(BSD4_2, [Define if the system is compatible with BSD 4.2.]) AH_TEMPLATE(BSD_SYSTEM, [Define if the system is compatible with BSD 4.2.]) +AH_TEMPLATE(DOS_NT, [Define if the system is MS DOS or MS Windows.]) +AH_TEMPLATE(MSDOS, [Define if the system is MS DOS.]) AH_TEMPLATE(USG, [Define if the system is compatible with System III.]) AH_TEMPLATE(USG5, [Define if the system is compatible with System V.]) AH_TEMPLATE(USG5_4, [Define if the system is compatible with System V Release 4.]) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index c753ab5a1a2..fa78cc4c502 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,4 +1,20 @@ -2012-07-21 Eli Zaretskii +2012-08-14 Eli Zaretskii + + * building.texi (Debugger Operation): Correct and improve + documentation of the GUD Tooltip mode. + +2012-07-31 Chong Yidong + + * emacs.texi: Fix ISBN (Bug#12080). + +2012-08-05 Chong Yidong + + * display.texi (Faces): Document frame-background-mode (Bug#7774). + + * custom.texi (Face Customization): Move discussion of face + inheritance here, from Faces section. + +2012-07-28 Eli Zaretskii * frames.texi (Mouse Commands): Fix the description of mouse-2. (Bug#11958) diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 2c4ed1fbcc8..487e3c19c16 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -365,7 +365,7 @@ flow control. @item Fabin E. Gallina rewrote @file{python.el}, the major mode for the -Python programming language used in Emacs 24.2 onwards. +Python programming language used in Emacs 24.3 onwards. @item Kevin Gallo added multiple-frame support for Windows NT and wrote @@ -715,7 +715,7 @@ the current window on which point is; @file{cap-words.el}, a minor mode for motion in ``CapitalizedWordIdentifiers''; @file{latin1-disp.el}, a package that lets you display ISO 8859 characters on Latin-1 terminals by setting up appropriate display tables; the version of -@file{python.el} used prior to Emacs 24.2; @file{smiley.el}, a +@file{python.el} used prior to Emacs 24.3; @file{smiley.el}, a facility for displaying smiley faces; @file{sym-comp.el}, a library for performing mode-dependent symbol completion; @file{benchmark.el} for timing code execution; and @file{tool-bar.el}, a mode to control diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 01e6e67b07e..05ea667e5f7 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -588,19 +588,25 @@ to recompile and restart the program. GUD Tooltip mode is a global minor mode that adds tooltip support to GUD. To toggle this mode, type @kbd{M-x gud-tooltip-mode}. It is disabled by default. If enabled, you can move the mouse cursor over a -variable to show its value in a tooltip (@pxref{Tooltips}); this takes -effect in the GUD interaction buffer, and in all source buffers with -major modes listed in the variable @code{gud-tooltip-modes}. If the -variable @code{gud-tooltip-echo-area} is non-@code{nil}, values are -shown in the echo area instead of a tooltip. +variable, a function, or a macro (collectively called +@dfn{identifiers}) to show their values in tooltips +(@pxref{Tooltips}). Alternatively, mark an identifier or an +expression by dragging the mouse over it, then leave the mouse in the +marked area to have the value of the expression displayed in a +tooltip. The GUD Tooltip mode takes effect in the GUD interaction +buffer, and in all source buffers with major modes listed in the +variable @code{gud-tooltip-modes}. If the variable +@code{gud-tooltip-echo-area} is non-@code{nil}, or if you turned off +the tooltip mode, values are shown in the echo area instead of a +tooltip. - When using GUD Tooltip mode with @kbd{M-x gud-gdb}, you should note -that displaying an expression's value in GDB can sometimes expand a -macro, potentially causing side effects in the debugged program. If -you use the @kbd{M-x gdb} interface, this problem does not occur, as -there is special code to avoid side-effects; furthermore, you can -display macro definitions associated with an identifier when the -program is not executing. + When using GUD Tooltip mode with @kbd{M-x gud-gdb}, displaying an +expression's value in GDB can sometimes expand a macro, potentially +causing side effects in the debugged program. For that reason, using +tooltips in @code{gud-gdb} is disabled. If you use the @kbd{M-x gdb} +interface, this problem does not occur, as there is special code to +avoid side-effects; furthermore, you can display macro definitions +associated with an identifier when the program is not executing. @node Commands of GUD @subsection Commands of GUD diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 2da70227c29..68219d7890f 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -450,11 +450,14 @@ attribute; an empty checkbox, @samp{[ ]}, means that the face does not specify any special value for the attribute. You can activate a checkbox to specify or unspecify its attribute. - Most faces only specify a few attributes (in the above example, -@code{font-lock-comment-face} only specifies the foreground color). -Emacs has a special face, @code{default}, whose attributes are all -specified; it determines the attributes left unspecified by other -faces. + A face does not have to specify every single attribute; in fact, +most faces only specify a few attributes. In the above example, +@code{font-lock-comment-face} only specifies the foreground color. +Any unspecified attribute is taken from the special face named +@code{default}, whose attributes are all specified. The +@code{default} face is the face used to display any text that does not +have an explicitly-assigned face; furthermore, its background color +attribute serves as the background color of the frame. The @samp{Hide Unused Attributes} button, at the end of the attribute list, hides the unspecified attributes of the face. When diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 2fa71127298..2238570eaa9 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -475,18 +475,26 @@ type @kbd{M-x list-faces-display}. With a prefix argument, this prompts for a regular expression, and displays only faces with names matching that regular expression (@pxref{Regexps}). +@vindex frame-background-mode It's possible for a given face to look different in different frames. For instance, some text terminals do not support all face attributes, particularly font, height, and width, and some support a -limited range of colors. +limited range of colors. In addition, most Emacs faces are defined so +that their attributes are different on light and dark frame +backgrounds, for reasons of legibility. By default, Emacs +automatically chooses which set of face attributes to display on each +frame, based on the frame's current background color. However, you +can override this by giving the variable @code{frame-background-mode} +a non-@code{nil} value. A value of @code{dark} makes Emacs treat all +frames as if they have a dark background, whereas a value of +@code{light} makes it treat all frames as if they have a light +background. @cindex background color @cindex default face - You can customize a face to alter its appearance, and save those -changes for future Emacs sessions. @xref{Face Customization}. A face -does not have to specify every single attribute; often it inherits -most attributes from another face. Any ultimately unspecified -attribute is taken from the face named @code{default}. + You can customize a face to alter its attributes, and save those +customizations for future Emacs sessions. @xref{Face Customization}, +for details. The @code{default} face is the default for displaying text, and all of its attributes are specified. Its background color is also used as diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 1b457e01943..6357aebc6ff 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -94,7 +94,7 @@ developing GNU and promoting software freedom.'' Published by the Free Software Foundation @* 51 Franklin Street, Fifth Floor @* Boston, MA 02110-1301 USA @* -ISBN 978-0-9831592-3-0 +ISBN 978-0-9831592-4-7 @sp 2 Cover art by Etienne Suvasa; cover design by Matt Lee. diff --git a/doc/emacs/emacsver.texi b/doc/emacs/emacsver.texi index 88c6f2c6045..3b54719ad77 100644 --- a/doc/emacs/emacsver.texi +++ b/doc/emacs/emacsver.texi @@ -1,4 +1,4 @@ @c It would be nicer to generate this using configure and @version@. @c However, that would mean emacsver.texi would always be newer @c then the info files in release tarfiles. -@set EMACSVER 24.1.50 +@set EMACSVER 24.2.50 diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 375e78eb319..6579cc48fd5 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,29 @@ +2012-08-06 Eli Zaretskii + + * functions.texi (Closures): Put the main index entry for + "closures" here. (Bug#12138) + + * variables.texi (Lexical Binding): Disambiguate the index entry + for "closures". + +2012-08-05 Chong Yidong + + * display.texi (Defining Faces): Move documentation of + frame-background-mode to the Emacs manual (Bug#7774). + +2012-08-04 Chong Yidong + + * syntax.texi (Syntax Basics): Rearrange the text for clarity. + Fix description of syntax table inheritance. + (Syntax Table Functions): Don't refer to internal contents of + syntax table, since that is not explained yet. Copyedits. + (Standard Syntax Tables): Node deleted. + (Syntax Table Internals): Misc clarifications. Improve table + formatting. + + * keymaps.texi (Inheritance and Keymaps): + * text.texi (Sticky Properties): Tweak index entry. + 2012-07-28 Eli Zaretskii * nonascii.texi (Character Sets): Fix a typo. (Bug#12062) @@ -4029,7 +4055,7 @@ * functions.texi (Function Safety): Texinfo usage fix. -2009-01-04 Eduard Wiebe (tiny patch) +2009-01-04 Eduard Wiebe (tiny change) * objects.texi (General Escape Syntax): Fix typo. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 01d177feb87..64aa891e56b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2040,14 +2040,6 @@ function, which is used to apply customized face settings. specify a face to use. In the vast majority of cases, this is not necessary; it is preferable to simply use faces directly. -@defopt frame-background-mode -This option, if non-@code{nil}, specifies the background type to use for -interpreting face definitions. If it is @code{dark}, then Emacs treats -all frames as if they had a dark background, regardless of their actual -background colors. If it is @code{light}, then Emacs treats all frames -as if they had a light background. -@end defopt - @node Face Attributes @subsection Face Attributes @cindex face attributes diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index a8b325c7150..caa5185dec3 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1241,7 +1241,6 @@ Syntax Tables * Motion and Syntax:: Moving over characters with certain syntaxes. * Parsing Expressions:: Parsing balanced expressions using the syntax table. -* Standard Syntax Tables:: Syntax tables used by various major modes. * Syntax Table Internals:: How syntax table information is stored. * Categories:: Another way of classifying character syntax. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index ab2789b5e6d..9e1d3f9c6ae 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1100,8 +1100,9 @@ named function that you create (e.g.@: with @code{defun}), as well as any anonymous function that you create using the @code{lambda} macro or the @code{function} special form or the @code{#'} syntax (@pxref{Anonymous Functions}), is automatically converted into a -closure. +@dfn{closure}. +@cindex closure A closure is a function that also carries a record of the lexical environment that existed when the function was defined. When it is invoked, any lexical variable references within its definition use the diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index ad7092a9ed7..f6ec0ae5e55 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -371,7 +371,7 @@ definition is a keymap; the same symbol appears in the new copy. @node Inheritance and Keymaps @section Inheritance and Keymaps @cindex keymap inheritance -@cindex inheriting a keymap's bindings +@cindex inheritance, keymap A keymap can inherit the bindings of another keymap, which we call the @dfn{parent keymap}. Such a keymap looks like this: diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index e4cdeb59811..ab685290901 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -23,7 +23,6 @@ Mode}) and the various complex movement commands (@pxref{Motion}). * Motion and Syntax:: Moving over characters with certain syntaxes. * Parsing Expressions:: Parsing balanced expressions using the syntax table. -* Standard Syntax Tables:: Syntax tables used by various major modes. * Syntax Table Internals:: How syntax table information is stored. * Categories:: Another way of classifying character syntax. @end menu @@ -31,43 +30,65 @@ Mode}) and the various complex movement commands (@pxref{Motion}). @node Syntax Basics @section Syntax Table Concepts - A syntax table is a char-table (@pxref{Char-Tables}). The element at -index @var{c} describes the character with code @var{c}. The element's -value should be a list that encodes the syntax of the character in -question. + A syntax table is a data structure which can be used to look up the +@dfn{syntax class} and other syntactic properties of each character. +Syntax tables are used by Lisp programs for scanning and moving across +text. - Syntax tables are used only for moving across text, not for the Emacs -Lisp reader. Emacs Lisp uses built-in syntactic rules when reading Lisp -expressions, and these rules cannot be changed. (Some Lisp systems -provide ways to redefine the read syntax, but we decided to leave this -feature out of Emacs Lisp for simplicity.) - - Each buffer has its own major mode, and each major mode has its own -idea of the syntactic class of various characters. For example, in -Lisp mode, the character @samp{;} begins a comment, but in C mode, it -terminates a statement. To support these variations, Emacs makes the -syntax table local to each buffer. Typically, each major mode has its -own syntax table and installs that table in each buffer that uses that -mode. Changing this table alters the syntax in all those buffers as -well as in any buffers subsequently put in that mode. Occasionally -several similar modes share one syntax table. @xref{Example Major -Modes}, for an example of how to set up a syntax table. - -A syntax table can inherit the data for some characters from the -standard syntax table, while specifying other characters itself. The -``inherit'' syntax class means ``inherit this character's syntax from -the standard syntax table''. Just changing the standard syntax for a -character affects all syntax tables that inherit from it. + Internally, a syntax table is a char-table (@pxref{Char-Tables}). +The element at index @var{c} describes the character with code +@var{c}; its value is a cons cell which specifies the syntax of the +character in question. @xref{Syntax Table Internals}, for details. +However, instead of using @code{aset} and @code{aref} to modify and +inspect syntax table contents, you should usually use the higher-level +functions @code{char-syntax} and @code{modify-syntax-entry}, which are +described in @ref{Syntax Table Functions}. @defun syntax-table-p object This function returns @code{t} if @var{object} is a syntax table. @end defun + Each buffer has its own major mode, and each major mode has its own +idea of the syntax class of various characters. For example, in Lisp +mode, the character @samp{;} begins a comment, but in C mode, it +terminates a statement. To support these variations, the syntax table +is local to each buffer. Typically, each major mode has its own +syntax table, which it installs in all buffers that use that mode. +For example, the variable @code{emacs-lisp-mode-syntax-table} holds +the syntax table used by Emacs Lisp mode, and +@code{c-mode-syntax-table} holds the syntax table used by C mode. +Changing a major mode's syntax table alters the syntax in all of that +mode's buffers, as well as in any buffers subsequently put in that +mode. Occasionally, several similar modes share one syntax table. +@xref{Example Major Modes}, for an example of how to set up a syntax +table. + +@cindex standard syntax table +@cindex inheritance, syntax table + A syntax table can @dfn{inherit} from another syntax table, which is +called its @dfn{parent syntax table}. A syntax table can leave the +syntax class of some characters unspecified, by giving them the +``inherit'' syntax class; such a character then acquires the syntax +class specified by the parent syntax table (@pxref{Syntax Class +Table}). Emacs defines a @dfn{standard syntax table}, which is the +default parent syntax table, and is also the syntax table used by +Fundamental mode. + +@defun standard-syntax-table +This function returns the standard syntax table, which is the syntax +table used in Fundamental mode. +@end defun + + Syntax tables are not used by the Emacs Lisp reader, which has its +own built-in syntactic rules which cannot be changed. (Some Lisp +systems provide ways to redefine the read syntax, but we decided to +leave this feature out of Emacs Lisp for simplicity.) + @node Syntax Descriptors @section Syntax Descriptors @cindex syntax class - The syntactic role of a character is called its @dfn{syntax class}. + The @dfn{syntax class} of a character describes its syntactic role. Each syntax table specifies the syntax class of each character. There is no necessary relationship between the class of a character in one syntax table and its class in any other table. @@ -81,21 +102,23 @@ independent of what syntax that character currently has. Thus, syntax, regardless of whether the @samp{\} character actually has that syntax in the current syntax table. @ifnottex -@xref{Syntax Class Table}, for a list of syntax classes. +@xref{Syntax Class Table}, for a list of syntax classes and their +designator characters. @end ifnottex @cindex syntax descriptor A @dfn{syntax descriptor} is a Lisp string that describes the syntax -classes and other syntactic properties of a character. When you want -to modify the syntax of a character, that is done by calling the -function @code{modify-syntax-entry} and passing a syntax descriptor as -one of its arguments (@pxref{Syntax Table Functions}). +class and other syntactic properties of a character. When you want to +modify the syntax of a character, that is done by calling the function +@code{modify-syntax-entry} and passing a syntax descriptor as one of +its arguments (@pxref{Syntax Table Functions}). - The first character in a syntax descriptor designates the syntax -class. The second character specifies a matching character (e.g.@: in -Lisp, the matching character for @samp{(} is @samp{)}); if there is no -matching character, put a space there. Then come the characters for -any desired flags. + The first character in a syntax descriptor must be a syntax class +designator character. The second character, if present, specifies a +matching character (e.g.@: in Lisp, the matching character for +@samp{(} is @samp{)}); a space specifies that there is no matching +character. Then come characters specifying additional syntax +properties (@pxref{Syntax Flags}). If no matching character or flags are needed, only one character (specifying the syntax class) is sufficient. @@ -348,7 +371,6 @@ character does not have the @samp{b} flag. @end table @item -@c Emacs 19 feature @samp{p} identifies an additional ``prefix character'' for Lisp syntax. These characters are treated as whitespace when they appear between expressions. When they appear within an expression, they are handled @@ -366,21 +388,20 @@ prefix (@samp{'}). @xref{Motion and Syntax}. altering syntax tables. @defun make-syntax-table &optional table -This function creates a new syntax table, with all values initialized -to @code{nil}. If @var{table} is non-@code{nil}, it becomes the -parent of the new syntax table, otherwise the standard syntax table is -the parent. Like all char-tables, a syntax table inherits from its -parent. Thus the original syntax of all characters in the returned -syntax table is determined by the parent. @xref{Char-Tables}. +This function creates a new syntax table. If @var{table} is +non-@code{nil}, the parent of the new syntax table is @var{table}; +otherwise, the parent is the standard syntax table. -Most major mode syntax tables are created in this way. +In the new syntax table, all characters are initially given the +``inherit'' (@samp{@@}) syntax class, i.e.@: their syntax is inherited +from the parent table (@pxref{Syntax Class Table}). @end defun @defun copy-syntax-table &optional table This function constructs a copy of @var{table} and returns it. If -@var{table} is not supplied (or is @code{nil}), it returns a copy of the -standard syntax table. Otherwise, an error is signaled if @var{table} is -not a syntax table. +@var{table} is omitted or @code{nil}, it returns a copy of the +standard syntax table. Otherwise, an error is signaled if @var{table} +is not a syntax table. @end defun @deffn Command modify-syntax-entry char syntax-descriptor &optional table @@ -393,11 +414,11 @@ between @var{min} and @var{max}, inclusive. The syntax is changed only for @var{table}, which defaults to the current buffer's syntax table, and not in any other syntax table. -The argument @var{syntax-descriptor} is a syntax descriptor for the -desired syntax (i.e.@: a string beginning with a class designator -character, and optionally containing a matching character and syntax -flags). An error is signaled if the first character is not one of the -seventeen syntax class designators. @xref{Syntax Descriptors}. +The argument @var{syntax-descriptor} is a syntax descriptor, i.e.@: a +string whose first character is a syntax class designator and whose +second and subsequent characters optionally specify a matching +character and syntax flags. @xref{Syntax Descriptors}. An error is +signaled if @var{syntax-descriptor} is not a valid syntax descriptor. This function always returns @code{nil}. The old syntax information in the table for this character is discarded. @@ -438,38 +459,37 @@ the table for this character is discarded. @defun char-syntax character This function returns the syntax class of @var{character}, represented -by its mnemonic designator character. This returns @emph{only} the -class, not any matching parenthesis or flags. +by its designator character (@pxref{Syntax Class Table}). This +returns @emph{only} the class, not its matching character or syntax +flags. -An error is signaled if @var{char} is not a character. - -The following examples apply to C mode. The first example shows that -the syntax class of space is whitespace (represented by a space). The -second example shows that the syntax of @samp{/} is punctuation. This -does not show the fact that it is also part of comment-start and -end -sequences. The third example shows that open parenthesis is in the class -of open parentheses. This does not show the fact that it has a matching -character, @samp{)}. +The following examples apply to C mode. (We use @code{string} to make +it easier to see the character returned by @code{char-syntax}.) @example @group +;; Space characters have whitespace syntax class. (string (char-syntax ?\s)) @result{} " " @end group @group +;; Forward slash characters have punctuation syntax. Note that this +;; @code{char-syntax} call does not reveal that it is also part of +;; comment-start and -end sequences. (string (char-syntax ?/)) @result{} "." @end group @group +;; Open parenthesis characters have open parenthesis syntax. Note +;; that this @code{char-syntax} call does not reveal that it has a +;; matching character, @samp{)}. (string (char-syntax ?\()) @result{} "(" @end group @end example -We use @code{string} to make it easier to see the character returned by -@code{char-syntax}. @end defun @defun set-syntax-table table @@ -905,135 +925,70 @@ The behavior of @code{parse-partial-sexp} is also affected by You can use @code{forward-comment} to move forward or backward over one comment or several comments. -@node Standard Syntax Tables -@section Some Standard Syntax Tables - - Most of the major modes in Emacs have their own syntax tables. Here -are several of them: - -@defun standard-syntax-table -This function returns the standard syntax table, which is the syntax -table used in Fundamental mode. -@end defun - -@defvar text-mode-syntax-table -The value of this variable is the syntax table used in Text mode. -@end defvar - -@defvar c-mode-syntax-table -The value of this variable is the syntax table for C-mode buffers. -@end defvar - -@defvar emacs-lisp-mode-syntax-table -The value of this variable is the syntax table used in Emacs Lisp mode -by editing commands. (It has no effect on the Lisp @code{read} -function.) -@end defvar - @node Syntax Table Internals @section Syntax Table Internals @cindex syntax table internals - Lisp programs don't usually work with the elements directly; the -Lisp-level syntax table functions usually work with syntax descriptors -(@pxref{Syntax Descriptors}). Nonetheless, here we document the -internal format. This format is used mostly when manipulating -syntax properties. + Syntax tables are implemented as char-tables (@pxref{Char-Tables}), +but most Lisp programs don't work directly with their elements. +Syntax tables do not store syntax data as syntax descriptors +(@pxref{Syntax Descriptors}); they use an internal format, which is +documented in this section. This internal format can also be assigned +as syntax properties (@pxref{Syntax Properties}). - Each element of a syntax table is a cons cell of the form -@code{(@var{syntax-code} . @var{matching-char})}. The @sc{car}, -@var{syntax-code}, is an integer that encodes the syntax class, and any -flags. The @sc{cdr}, @var{matching-char}, is non-@code{nil} if -a character to match was specified. +@cindex syntax code + Each entry in a syntax table is a cons cell of the form +@code{(@var{syntax-code} . @var{matching-char})}. @var{syntax-code} +is an integer that encodes the syntax class and syntax flags, +according to the table below. @var{matching-char}, if non-@code{nil}, +specifies a matching character (similar to the second character in a +syntax descriptor). - This table gives the value of @var{syntax-code} which corresponds -to each syntactic type. - -@multitable @columnfractions .05 .3 .3 .31 +@multitable @columnfractions .2 .3 .2 .3 @item -@tab -@i{Integer} @i{Class} -@tab -@i{Integer} @i{Class} -@tab -@i{Integer} @i{Class} +@i{Syntax code} @tab @i{Class} @tab @i{Syntax code} @tab @i{Class} @item -@tab -0 @ @ whitespace -@tab -5 @ @ close parenthesis -@tab -10 @ @ character quote +0 @tab whitespace @tab 8 @tab paired delimiter @item -@tab -1 @ @ punctuation -@tab -6 @ @ expression prefix -@tab -11 @ @ comment-start +1 @tab punctuation @tab 9 @tab escape @item -@tab -2 @ @ word -@tab -7 @ @ string quote -@tab -12 @ @ comment-end +2 @tab word @tab 10 @tab character quote @item -@tab -3 @ @ symbol -@tab -8 @ @ paired delimiter -@tab -13 @ @ inherit +3 @tab symbol @tab 11 @tab comment-start @item -@tab -4 @ @ open parenthesis -@tab -9 @ @ escape -@tab -14 @ @ generic comment +4 @tab open parenthesis @tab 12 @tab comment-end @item -@tab -15 @ generic string +5 @tab close parenthesis @tab 13 @tab inherit +@item +6 @tab expression prefix @tab 14 @tab generic comment +@item +7 @tab string quote @tab 15 @tab generic string @end multitable - For example, the usual syntax value for @samp{(} is @code{(4 . 41)}. -(41 is the character code for @samp{)}.) +@noindent +For example, in the standard syntax table, the entry for @samp{(} is +@code{(4 . 41)}. (41 is the character code for @samp{)}.) - The flags are encoded in higher order bits, starting 16 bits from the -least significant bit. This table gives the power of two which + Syntax flags are encoded in higher order bits, starting 16 bits from +the least significant bit. This table gives the power of two which corresponds to each syntax flag. -@multitable @columnfractions .05 .3 .3 .3 +@multitable @columnfractions .15 .3 .15 .3 @item -@tab -@i{Prefix} @i{Flag} -@tab -@i{Prefix} @i{Flag} -@tab -@i{Prefix} @i{Flag} +@i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag} @item -@tab -@samp{1} @ @ @code{(lsh 1 16)} -@tab -@samp{4} @ @ @code{(lsh 1 19)} -@tab -@samp{b} @ @ @code{(lsh 1 21)} +@samp{1} @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)} @item -@tab -@samp{2} @ @ @code{(lsh 1 17)} -@tab -@samp{p} @ @ @code{(lsh 1 20)} -@tab -@samp{n} @ @ @code{(lsh 1 22)} +@samp{2} @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)} @item -@tab -@samp{3} @ @ @code{(lsh 1 18)} +@samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)} +@item +@samp{4} @tab @code{(lsh 1 19)} @end multitable @defun string-to-syntax @var{desc} -This function returns the internal form corresponding to the syntax -descriptor @var{desc}, a cons cell @code{(@var{syntax-code} +Given a syntax descriptor @var{desc}, this function returns the +corresponding internal form, a cons cell @code{(@var{syntax-code} . @var{matching-char})}. @end defun diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index d115322f84f..fe7f24e42cd 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -3382,7 +3382,7 @@ of the text. @node Sticky Properties @subsection Stickiness of Text Properties @cindex sticky text properties -@cindex inheritance of text properties +@cindex inheritance, text property Self-inserting characters normally take on the same properties as the preceding character. This is called @dfn{inheritance} of properties. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index affaff46ff9..3b078e7e19f 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -967,11 +967,11 @@ wants the current value of a variable, it looks first in the lexical environment; if the variable is not specified in there, it looks in the symbol's value cell, where the dynamic value is stored. -@cindex closures +@cindex closures, example of using Lexical bindings have indefinite extent. Even after a binding construct has finished executing, its lexical environment can be ``kept around'' in Lisp objects called @dfn{closures}. A closure is -created when you create a named or anonymous function with lexical +created when you define a named or anonymous function with lexical binding enabled. @xref{Closures}, for details. When a closure is called as a function, any lexical variable diff --git a/doc/man/emacs.1 b/doc/man/emacs.1 index d3d8a0095b8..a3d73800503 100644 --- a/doc/man/emacs.1 +++ b/doc/man/emacs.1 @@ -1,5 +1,5 @@ .\" See section COPYING for copyright and redistribution information. -.TH EMACS 1 "2007 April 13" "GNU Emacs 24.1.50" +.TH EMACS 1 "2007 April 13" "GNU Emacs 24.2.50" . . .SH NAME diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index d0f60c60234..20c74cf70b2 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,27 @@ +2012-08-06 Aurélien Aptel + + * url.texi (Parsed URLs): Adjust to the code's use of defstruct + (bug#12096). + +2012-08-01 Jay Belanger + + * calc.texi (Simplification modes, Conversions) + (Operating on Selections): Mention "basic" simplification. + (The Calc Mode Line): Mention the mode line display for Basic + simplification mode. + (Simplify Formulas): Refer to 'algebraic' rather than 'default' + simplifications. + (Basic Simplifications): Rename from "Limited Simplifications" + Replace "limited" by "basic" throughout. + (Algebraic Simplifications): Indicate that the algebraic + simplifications are done by default. + (Unsafe Simplifications): Mention `m E'. + (Simplification of Units): Mention `m U'. + (Trigonometric/Hyperbolic Functions, Reducing and Mapping) + (Kinds of Declarations, Functions for Declarations): Mention + "algebraic simplifications" instead of `a s'. + (Algebraic Entry): Remove mention of default simplifications. + 2012-07-30 Jay Belanger * calc.texi (Getting Started, Tutorial): Change simulated diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 301866ad65c..f8f6d06b93a 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10123,7 +10123,7 @@ formula that goes onto the stack. (Thus @kbd{' pi @key{RET}} pushes the variable @samp{pi}, but @kbd{' pi M-@key{RET}} pushes 3.1415.) If you finish your algebraic entry by pressing @key{LFD} (or @kbd{C-j}) -instead of @key{RET}, Calc disables the default simplifications +instead of @key{RET}, Calc disables simplification (as if by @kbd{m O}; @pxref{Simplification Modes}) while the entry is being pushed on the stack. Thus @kbd{' 1+2 @key{RET}} pushes 3 on the stack, but @kbd{' 1+2 @key{LFD}} pushes the formula @expr{1+2}; @@ -12569,7 +12569,7 @@ are ``normalized'' when being taken from or pushed onto the stack. Some normalizations are unavoidable, such as rounding floating-point results to the current precision, and reducing fractions to simplest form. Others, such as simplifying a formula like @expr{a+a} (or @expr{2+3}), -are done by default but can be turned off when necessary. +are done automatically but can be turned off when necessary. When you press a key like @kbd{+} when @expr{2} and @expr{3} are on the stack, Calc pops these numbers, normalizes them, creates the formula @@ -12603,9 +12603,9 @@ A constant is a number or other numeric object (such as a constant error form or modulo form), or a vector all of whose elements are constant. -@kindex m L -@pindex calc-limited-simplify-mode -The @kbd{m L} (@code{calc-limited-simplify-mode}) command does limited +@kindex m I +@pindex calc-basic-simplify-mode +The @kbd{m I} (@code{calc-basic-simplify-mode}) command does some basic simplifications for all formulas. This includes many easy and fast algebraic simplifications such as @expr{a+0} to @expr{a}, and @expr{a + 2 a} to @expr{3 a}, as well as evaluating functions like @@ -12613,30 +12613,28 @@ fast algebraic simplifications such as @expr{a+0} to @expr{a}, and @kindex m B @pindex calc-bin-simplify-mode -The @kbd{m B} (@code{calc-bin-simplify-mode}) mode applies the limited +The @kbd{m B} (@code{calc-bin-simplify-mode}) mode applies the basic simplifications to a result and then, if the result is an integer, uses the @kbd{b c} (@code{calc-clip}) command to clip the integer according to the current binary word size. @xref{Binary Functions}. Real numbers are rounded to the nearest integer and then clipped; other kinds of -results (after the default simplifications) are left alone. +results (after the basic simplifications) are left alone. -@kindex m D -@pindex calc-default-simplify-mode -The @kbd{m D} (@code{calc-default-simplify-mode}) mode does standard +@kindex m A +@pindex calc-alg-simplify-mode +The @kbd{m A} (@code{calc-alg-simplify-mode}) mode does standard algebraic simplifications. @xref{Algebraic Simplifications}. @kindex m E @pindex calc-ext-simplify-mode -The @kbd{m E} (@code{calc-ext-simplify-mode}) mode does ``extended'' -algebraic simplification, as by the @kbd{a e} (@code{calc-simplify-extended}) -command. @xref{Unsafe Simplifications}. +The @kbd{m E} (@code{calc-ext-simplify-mode}) mode does ``extended'', or +``unsafe'', algebraic simplification. @xref{Unsafe Simplifications}. @kindex m U @pindex calc-units-simplify-mode The @kbd{m U} (@code{calc-units-simplify-mode}) mode does units -simplification; it applies the command @kbd{u s} -(@code{calc-simplify-units}), which in turn -is a superset of @kbd{a s}. In this mode, variable names which +simplification. @xref{Simplification of Units}. These include the +algebraic simplifications, plus variable names which are identifiable as unit names (like @samp{mm} for ``millimeters'') are simplified with their unit definitions in mind. @@ -12853,8 +12851,8 @@ roots (if any) will be included in the list. only when certain values are integers (such as @samp{(x^y)^z} shown above). -Another command that makes use of declarations is @kbd{a s}, when -simplifying equations and inequalities. It will cancel @code{x} +Calc's algebraic simplifications also make use of declarations when +simplifying equations and inequalities. They will cancel @code{x} from both sides of @samp{a x = b x} only if it is sure @code{x} is non-zero, say, because it has a @code{pos} declaration. To declare specifically that @code{x} is real and non-zero, @@ -12992,10 +12990,10 @@ i.e., is mathematically equal to a real number times @expr{i}. The @code{dpos} function checks for positive (but nonzero) reals. The @code{dneg} function checks for negative reals. The @code{dnonneg} function checks for nonnegative reals, i.e., reals greater than or -equal to zero. Note that the @kbd{a s} command can simplify an -expression like @expr{x > 0} to 1 or 0 using @code{dpos}, and that -@kbd{a s} is effectively applied to all conditions in rewrite rules, -so the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} +equal to zero. Note that Calc's algebraic simplifications, which are +effectively applied to all conditions in rewrite rules, can simplify +an expression like @expr{x > 0} to 1 or 0 using @code{dpos}. +So the actual functions @code{dpos}, @code{dneg}, and @code{dnonneg} are rarely necessary. @ignore @@ -13021,7 +13019,7 @@ also the set of objects considered ``true'' in conditional contexts.) The @code{deven} function returns 1 if its argument is known to be an even integer (or integer-valued float); it returns 0 if its argument is known not to be even (because it is known to be odd or a non-integer). -The @kbd{a s} command uses this to simplify a test of the form +Calc's algebraic simplifications use this to simplify a test of the form @samp{x % 2 = 0}. There is also an analogous @code{dodd} function. @ignore @@ -15648,7 +15646,7 @@ The exact sequence of events is as follows: When Calc tries a rule, it first matches the pattern as usual. It then substitutes @samp{#1}, @samp{#2}, etc., in the conditions, if any. Next, the conditions are simplified and evaluated in order from left to right, -as if by the @w{@kbd{a s}} algebra command (@pxref{Simplifying Formulas}). +using the algebraic simplifications (@pxref{Simplifying Formulas}). Each result is true if it is a nonzero number, or an expression that can be proven to be nonzero (@pxref{Declarations}). If the results of all conditions are true, the expression (such as @@ -15876,8 +15874,8 @@ Default simplifications for numeric arguments only (@kbd{m N}). @item BinSimp@var{w} Binary-integer simplification mode; word size @var{w} (@kbd{m B}, @kbd{b w}). -@item LimSimp -Limited simplification mode (@kbd{m L}). +@item BasicSimp +Basic simplification mode (@kbd{m I}). @item ExtSimp Extended algebraic simplification mode (@kbd{m E}). @@ -16716,10 +16714,10 @@ produced!) Integers and fractions are generally unaffected by this operation. Vectors and formulas are cleaned by cleaning each component number (i.e., pervasively). -If the simplification mode is set below the limited level, it is raised -to the limited level for the purposes of this command. Thus, @kbd{c c} -applies the limited simplifications even if their automatic application -is disabled. @xref{Simplification Modes}. +If the simplification mode is set below basic simplification, it is raised +for the purposes of this command. Thus, @kbd{c c} applies the basic +simplifications even if their automatic application is disabled. +@xref{Simplification Modes}. @cindex Roundoff errors, correcting A numeric prefix argument to @kbd{c c} sets the floating-point precision @@ -18328,7 +18326,7 @@ reason why changing built-in variables is a bad idea. Arguments of the form @expr{x} plus a multiple of @cpiover{2} are also simplified. Calc includes similar formulas for @code{cos} and @code{tan}. -The @kbd{a s} command knows all angles which are integer multiples of +Calc's algebraic simplifications know all angles which are integer multiples of @cpiover{12}, @cpiover{10}, or @cpiover{8} radians. In Degrees mode, analogous simplifications occur for integer multiples of 15 or 18 degrees, and for arguments plus multiples of 90 degrees. @@ -22126,7 +22124,7 @@ now to take the cosine of the selected part.) @kindex j v @pindex calc-sel-evaluate The @kbd{j v} (@code{calc-sel-evaluate}) command performs the -limited simplifications on the selected sub-formula. +basic simplifications on the selected sub-formula. These simplifications would normally be done automatically on all results, but may have been partially inhibited by previous selection-related operations, or turned off altogether @@ -22178,9 +22176,9 @@ but which also substitutes stored values for variables in the formula. Use @kbd{a v} if you want the variables to ignore their stored values. If you give a numeric prefix argument of 2 to @kbd{a v}, it simplifies -as if in Algebraic Simplification mode. This is equivalent to typing -@kbd{a s}; @pxref{Simplifying Formulas}. If you give a numeric prefix -of 3 or more, it uses Extended Simplification mode (@kbd{a e}). +using Calc's algebraic simplifications; @pxref{Simplifying Formulas}. +If you give a numeric prefix of 3 or more, it uses Extended +Simplification mode (@kbd{a e}). If you give a negative prefix argument @mathit{-1}, @mathit{-2}, or @mathit{-3}, it simplifies in the corresponding mode but only works on the top-level @@ -22253,8 +22251,8 @@ If inequalities with opposite direction (e.g., @samp{<} and @samp{>}) are mapped, the direction of the second inequality is reversed to match the first: Using @kbd{a M +} on @samp{a < b} and @samp{a > 2} reverses the latter to get @samp{2 < a}, which then allows the -combination @samp{a + 2 < b + a}, which the @kbd{a s} command can -then simplify to get @samp{2 < b}. +combination @samp{a + 2 < b + a}, which the algebraic simplifications +can reduce to @samp{2 < b}. Using @kbd{a M *}, @kbd{a M /}, @kbd{a M n}, or @kbd{a M &} to negate or invert an inequality will reverse the direction of the inequality. @@ -22334,19 +22332,20 @@ and rewrite rules. @xref{Rearranging with Selections}. @xref{Rewrite Rules}. @xref{Simplification Modes}, for commands to control what level of -simplification occurs automatically. Normally only the default -algebraic simplifications occur. If you have turned on a -simplification mode which does not do these default simplifications, -you can still perform them on a formula with the @kbd{a s} command. +simplification occurs automatically. Normally the algebraic +simplifications described below occur. If you have turned on a +simplification mode which does not do these algebraic simplifications, +you can still apply them to a formula with the @kbd{a s} +(@code{calc-simplify}) [@code{simplify}] command. There are some simplifications that, while sometimes useful, are never done automatically. For example, the @kbd{I} prefix can be given to @kbd{a s}; the @kbd{I a s} command will change any trigonometric function to the appropriate combination of @samp{sin}s and @samp{cos}s before simplifying. This can be useful in simplifying even mildly -complicated trigonometric expressions. For example, while @kbd{a s} -can reduce @samp{sin(x) csc(x)} to @samp{1}, it will not simplify -@samp{sin(x)^2 csc(x)}. The command @kbd{I a s} can be used to +complicated trigonometric expressions. For example, while the algebraic +simplifications can reduce @samp{sin(x) csc(x)} to @samp{1}, they will not +simplify @samp{sin(x)^2 csc(x)}. The command @kbd{I a s} can be used to simplify this latter expression; it will transform @samp{sin(x)^2 csc(x)} into @samp{sin(x)}. However, @kbd{I a s} will also perform some ``simplifications'' which may not be desired; for example, it @@ -22357,21 +22356,22 @@ combinations of @samp{sinh}s and @samp{cosh}s before simplifying. @menu -* Limited Simplifications:: +* Basic Simplifications:: * Algebraic Simplifications:: * Unsafe Simplifications:: * Simplification of Units:: @end menu -@node Limited Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas -@subsection Limited Simplifications +@node Basic Simplifications, Algebraic Simplifications, Simplifying Formulas, Simplifying Formulas +@subsection Basic Simplifications @noindent -@cindex Limited simplifications -This section describes a limited set of simplifications. These, as -well as those described in the next section, are normally applied to -all results. You can type @kbd{m L} to restrict the simplifications -done on the stack to this limited set. +@cindex Basic simplifications +This section describes basic simplifications which Calc performs in many +situations. For example, both binary simplifications and algebraic +simplifications begin by performing these basic simplifications. You +can type @kbd{m I} to restrict the simplifications done on the stack to +these simplifications. The most basic simplification is the evaluation of functions. For example, @expr{2 + 3} is evaluated to @expr{5}, and @expr{@tfn{sqrt}(9)} @@ -22391,7 +22391,7 @@ operator) do not evaluate their arguments, @code{if} (the @code{? :} operator) does not evaluate all of its arguments, and @code{evalto} does not evaluate its lefthand argument. -Most commands apply at least these limited simplifications to all +Most commands apply at least these basic simplifications to all arguments they take from the stack, perform a particular operation, then simplify the result before pushing it back on the stack. In the common special case of regular arithmetic commands like @kbd{+} and @@ -22400,7 +22400,7 @@ and collected into a suitable function call, which is then simplified (the arguments being simplified first as part of the process, as described above). -Even the limited set of simplifications are too numerous to describe +Even the basic set of simplifications are too numerous to describe completely here, but this section will describe the ones that apply to the major arithmetic operators. This list will be rather technical in nature, and will probably be interesting to you only if you are @@ -22412,14 +22412,14 @@ a serious user of Calc's algebra facilities. As well as the simplifications described here, if you have stored any rewrite rules in the variable @code{EvalRules} then these rules -will also be applied before any built-in default simplifications. +will also be applied before any of the basic simplifications. @xref{Automatic Rewrites}, for details. @tex \bigskip @end tex -And now, on with the limited set of simplifications: +And now, on with the basic simplifications: Arithmetic operators like @kbd{+} and @kbd{*} always take two arguments in Calc's internal form. Sums and products of three or @@ -22438,11 +22438,11 @@ commutative law (@expr{a + b} to @expr{b + a}) except in a few special cases described below. Some algebra programs always rearrange terms into a canonical order, which enables them to see that @expr{a b + b a} can be simplified to @expr{2 a b}. -Calc assumes you have put the terms into the order you want -and generally leaves that order alone, with the consequence -that formulas like the above will only be simplified if you -explicitly give the @kbd{a s} command. @xref{Algebraic -Simplifications}. +If you are using Basic Simplification mode, Calc assumes you have put +the terms into the order you want and generally leaves that order alone, +with the consequence that formulas like the above will only be +simplified if you explicitly give the @kbd{a s} command. +@xref{Algebraic Simplifications}. Differences @expr{a - b} are treated like sums @expr{a + (-b)} for purposes of simplification; one of the default simplifications @@ -22473,9 +22473,8 @@ for adjacent terms in a larger sum. Thus @expr{a + b + b + c} is simplified to @expr{a + 2 b + c}, but @expr{a + b + c + b} is not simplified. The reason is that comparing all terms of a sum with one another would require time proportional to the -square of the number of terms; Calc relegates potentially slow -operations like this to commands that have to be invoked -explicitly, like @kbd{a s}. +square of the number of terms; Calc omits potentially slow +operations like this in basic simplification mode. Finally, @expr{a + 0} and @expr{0 + a} are simplified to @expr{a}. A consequence of the above rules is that @expr{0 - a} is simplified @@ -22672,9 +22671,9 @@ and @expr{b} are known to be real. Functions like @code{sin} and @code{arctan} generally don't have any default simplifications beyond simply evaluating the functions -for suitable numeric arguments and infinity. The @kbd{a s} command -described in the next section does provide some simplifications for -these functions, though. +for suitable numeric arguments and infinity. The algebraic +simplifications described in the next section do provide some +simplifications for these functions, though. One important simplification that does occur is that @expr{@tfn{ln}(@tfn{e})} is simplified to 1, and @expr{@tfn{ln}(@tfn{e}^x)} is @@ -22689,25 +22688,23 @@ and reversing the inequality. While it might seem reasonable to simplify @expr{!!x} to @expr{x}, this would not be valid in general because @expr{!!2} is 1, not 2. -Most other Calc functions have few if any default simplifications +Most other Calc functions have few if any basic simplifications defined, aside of course from evaluation when the arguments are suitable numbers. -@node Algebraic Simplifications, Unsafe Simplifications, Limited Simplifications, Simplifying Formulas +@node Algebraic Simplifications, Unsafe Simplifications, Basic Simplifications, Simplifying Formulas @subsection Algebraic Simplifications @noindent @cindex Algebraic simplifications @kindex a s -@kindex I a s -@kindex H a s -@pindex calc-simplify -@tindex simplify +@kindex m A This section describes all simplifications that are performed by -the default algebraic simplification mode. If you have switched to a different -simplification mode, you can switch back with the @kbd{m D} command. -Even in other simplification modes, the @kbd{a s} command will use -these algebraic simplifications to simplifies the formula. +the algebraic simplification mode, which is the default simplification +mode. If you have switched to a different simplification mode, you can +switch back with the @kbd{m A} command. Even in other simplification +modes, the @kbd{a s} command will use these algebraic simplifications to +simplify the formula. There is a variable, @code{AlgSimpRules}, in which you can put rewrites to be applied. Its use is analogous to @code{EvalRules}, @@ -22715,7 +22712,7 @@ but without the special restrictions. Basically, the simplifier does @samp{@w{a r} AlgSimpRules} with an infinite repeat count on the whole expression being simplified, then it traverses the expression applying the built-in rules described below. If the result is different from -the original expression, the process repeats with the limited +the original expression, the process repeats with the basic simplifications (including @code{EvalRules}), then @code{AlgSimpRules}, then the built-in simplifications, and so on. @@ -22731,8 +22728,8 @@ commuted to @expr{-x + 2}. Also, terms of sums are combined by the distributive law, as in @expr{x + y + 2 x} to @expr{y + 3 x}. This always occurs for -adjacent terms, but @kbd{a s} compares all pairs of terms including -non-adjacent ones. +adjacent terms, but Calc's algebraic simplifications compare all pairs +of terms including non-adjacent ones. @tex \bigskip @@ -22740,7 +22737,7 @@ non-adjacent ones. Products are sorted into a canonical order using the commutative law. For example, @expr{b c a} is commuted to @expr{a b c}. -This allows easier comparison of products; for example, the limited +This allows easier comparison of products; for example, the basic simplifications will not change @expr{x y + y x} to @expr{2 x y}, but the algebraic simplifications; it first rewrites the sum to @expr{x y + x y} which can then be recognized as a sum of identical @@ -22799,10 +22796,10 @@ simplified successfully. Integer powers of the variable @code{i} are simplified according to the identity @expr{i^2 = -1}. If you store a new value other than the complex number @expr{(0,1)} in @code{i}, this simplification -will no longer occur. This is not done by the limited +will no longer occur. This is not done by the basic simplifications; in case someone (unwisely) wants to use the name @code{i} for a variable unrelated to complex numbers, they can use -limited simplifications. +basic simplification mode. Square roots of integer or rational arguments are simplified in several ways. (Note that these will be left unevaluated only in @@ -22935,21 +22932,26 @@ as is @expr{x^2 >= 0} if @expr{x} is known to be real. @cindex Unsafe simplifications @cindex Extended simplification @kindex a e +@kindex m E @pindex calc-simplify-extended @ignore @mindex esimpl@idots @end ignore @tindex esimplify -The @kbd{a e} (@code{calc-simplify-extended}) [@code{esimplify}] command -is like @kbd{a s} -except that it applies some additional simplifications which are not -``safe'' in all cases. Use this only if you know the values in your -formula lie in the restricted ranges for which these simplifications -are valid. The symbolic integrator uses @kbd{a e}; -one effect of this is that the integrator's results must be used with -caution. Where an integral table will often attach conditions like -``for positive @expr{a} only,'' Calc (like most other symbolic -integration programs) will simply produce an unqualified result. +Calc is capable of performing some simplifications which may sometimes +be desired but which are not ``safe'' in all cases. The @kbd{a e} +(@code{calc-simplify-extended}) [@code{esimplify}] command +applies the algebraic simplifications as well as these extended, or +``unsafe'', simplifications. Use this only if you know the values in +your formula lie in the restricted ranges for which these +simplifications are valid. You can use Extended Simplification mode +(@kbd{m E}) to have these simplifications done automatically. + +The symbolic integrator uses these extended simplifications; one effect +of this is that the integrator's results must be used with caution. +Where an integral table will often attach conditions like ``for positive +@expr{a} only,'' Calc (like most other symbolic integration programs) +will simply produce an unqualified result. Because @kbd{a e}'s simplifications are unsafe, it is sometimes better to type @kbd{C-u -3 a v}, which does extended simplification only @@ -22957,21 +22959,20 @@ on the top level of the formula without affecting the sub-formulas. In fact, @kbd{C-u -3 j v} allows you to target extended simplification to any specific part of a formula. -The variable @code{ExtSimpRules} contains rewrites to be applied by -the @kbd{a e} command. These are applied in addition to +The variable @code{ExtSimpRules} contains rewrites to be applied when +the extended simplifications are used. These are applied in addition to @code{EvalRules} and @code{AlgSimpRules}. (The @kbd{a r AlgSimpRules} step described above is simply followed by an @kbd{a r ExtSimpRules} step.) -Following is a complete list of ``unsafe'' simplifications performed -by @kbd{a e}. +Following is a complete list of the ``unsafe'' simplifications. @tex \bigskip @end tex Inverse trigonometric or hyperbolic functions, called with their -corresponding non-inverse functions as arguments, are simplified -by @kbd{a e}. For example, @expr{@tfn{arcsin}(@tfn{sin}(x))} changes +corresponding non-inverse functions as arguments, are simplified. +For example, @expr{@tfn{arcsin}(@tfn{sin}(x))} changes to @expr{x}. Also, @expr{@tfn{arcsin}(@tfn{cos}(x))} and @expr{@tfn{arccos}(@tfn{sin}(x))} both change to @expr{@tfn{pi}/2 - x}. These simplifications are unsafe because they are valid only for @@ -23011,8 +23012,8 @@ simplifications are safe if @expr{x} is known to be real). Common factors are canceled from products on both sides of an equation, even if those factors may be zero: @expr{a x / b x} to @expr{a / b}. Such factors are never canceled from -inequalities: Even @kbd{a e} is not bold enough to reduce -@expr{a x < b x} to @expr{a < b} (or @expr{a > b}, depending +inequalities: Even the extended simplifications are not bold enough to +reduce @expr{a x < b x} to @expr{a < b} (or @expr{a > b}, depending on whether you believe @expr{x} is positive or negative). The @kbd{a M /} command can be used to divide a factor out of both sides of an inequality. @@ -23021,13 +23022,14 @@ both sides of an inequality. @subsection Simplification of Units @noindent -The simplifications described in this section are applied by the -@kbd{u s} (@code{calc-simplify-units}) command. These are in addition -to the regular @kbd{a s} (but not @kbd{a e}) simplifications described -earlier. @xref{Basic Operations on Units}. +The simplifications described in this section (as well as the algebraic +simplifications) are applied when units need to be simplified. They can +be applied using the @kbd{u s} (@code{calc-simplify-units}) command, or +will be done automatically in Units Simplification mode (@kbd{m U}). +@xref{Basic Operations on Units}. The variable @code{UnitSimpRules} contains rewrites to be applied by -the @kbd{u s} command. These are applied in addition to @code{EvalRules} +units simplifications. These are applied in addition to @code{EvalRules} and @code{AlgSimpRules}. Scalar mode is automatically put into effect when simplifying units. @@ -23581,10 +23583,11 @@ forever!) @vindex IntegSimpRules Another set of rules, stored in @code{IntegSimpRules}, are applied -every time the integrator uses @kbd{a s} to simplify an intermediate -result. For example, putting the rule @samp{twice(x) := 2 x} into -@code{IntegSimpRules} would tell Calc to convert the @code{twice} -function into a form it knows whenever integration is attempted. +every time the integrator uses algebraic simplifications to simplify an +intermediate result. For example, putting the rule +@samp{twice(x) := 2 x} into @code{IntegSimpRules} would tell Calc to +convert the @code{twice} function into a form it knows whenever +integration is attempted. One more way to influence the integrator is to define a function with the @kbd{Z F} command (@pxref{Algebraic Definitions}). Calc's @@ -23602,8 +23605,8 @@ above to try to hint at a more direct path to the desired result, or you can use @code{IntegAfterRules}. This is an extra rule set that runs after the main integrator returns its result; basically, Calc does an @kbd{a r IntegAfterRules} on the result before showing it to you. -(It also does an @kbd{a s}, without @code{IntegSimpRules}, after that -to further simplify the result.) For example, Calc's integrator +(It also does algebraic simplifications, without @code{IntegSimpRules}, +after that to further simplify the result.) For example, Calc's integrator sometimes produces expressions of the form @samp{ln(1+x) - ln(1-x)}; the default @code{IntegAfterRules} rewrite this into the more readable form @samp{2 arctanh(x)}. Note that, unlike @code{IntegRules}, @@ -25414,7 +25417,7 @@ The limits of a sum do not need to be integers. For example, @samp{sum(a_k, k, 0, 2 n, n)} produces @samp{a_0 + a_n + a_(2 n)}. Calc computes the number of iterations using the formula @samp{1 + (@var{high} - @var{low}) / @var{step}}, which must, -after simplification as if by @kbd{a s}, evaluate to an integer. +after algebraic simplification, evaluate to an integer. If the number of iterations according to the above formula does not come out to an integer, the sum is invalid and will be left @@ -26038,7 +26041,7 @@ rule, this is an additional condition that must be satisfied before the rule is accepted. Once @var{old} has been successfully matched to the target expression, @var{cond} is evaluated (with all the meta-variables substituted for the values they matched) and simplified -with @kbd{a s} (@code{calc-simplify}). If the result is a nonzero +with Calc's algebraic simplifications. If the result is a nonzero number or any other object known to be nonzero (@pxref{Declarations}), the rule is accepted. If the result is zero or if it is a symbolic formula that is not known to be nonzero, the rule is rejected. @@ -26718,7 +26721,7 @@ whereas @samp{eval(cons(2+3, []))} will be converted to @samp{[5]}. @end ignore @tindex evalsimp The formula @expr{x} has meta-variables substituted in the usual -way, then algebraically simplified as if by the @kbd{a s} command. +way, then algebraically simplified. @item evalextsimp(x) @ignore @@ -26741,15 +26744,15 @@ There are also some special functions you can use in conditions. @end ignore @tindex let The expression @expr{x} is evaluated with meta-variables substituted. -The @kbd{a s} command's simplifications are @emph{not} applied by +The algebraic simplifications are @emph{not} applied by default, but @expr{x} can include calls to @code{evalsimp} or @code{evalextsimp} as described above to invoke higher levels -of simplification. The -result of @expr{x} is then bound to the meta-variable @expr{v}. As -usual, if this meta-variable has already been matched to something -else the two values must be equal; if the meta-variable is new then -it is bound to the result of the expression. This variable can then -appear in later conditions, and on the righthand side of the rule. +of simplification. The result of @expr{x} is then bound to the +meta-variable @expr{v}. As usual, if this meta-variable has already +been matched to something else the two values must be equal; if the +meta-variable is new then it is bound to the result of the expression. +This variable can then appear in later conditions, and on the righthand +side of the rule. In fact, @expr{v} may be any pattern in which case the result of evaluating @expr{x} is matched to that pattern, binding any meta-variables that appear in that pattern. Note that @code{let} @@ -27499,17 +27502,19 @@ with @code{apply} as the top-level pattern must be tested against @cindex @code{AlgSimpRules} variable @vindex AlgSimpRules Suppose you want @samp{sin(a + b)} to be expanded out not all the time, -but only when @kbd{a s} is used to simplify the formula. The variable -@code{AlgSimpRules} holds rules for this purpose. The @kbd{a s} command -will apply @code{EvalRules} and @code{AlgSimpRules} to the formula, as -well as all of its built-in simplifications. +but only when algebraic simplifications are used to simplify the +formula. The variable @code{AlgSimpRules} holds rules for this purpose. +The @kbd{a s} command will apply @code{EvalRules} and +@code{AlgSimpRules} to the formula, as well as all of its built-in +simplifications. Most of the special limitations for @code{EvalRules} don't apply to @code{AlgSimpRules}. Calc simply does an @kbd{a r AlgSimpRules} -command with an infinite repeat count as the first step of @kbd{a s}. -It then applies its own built-in simplifications throughout the -formula, and then repeats these two steps (along with applying the -default simplifications) until no further changes are possible. +command with an infinite repeat count as the first step of algebraic +simplifications. It then applies its own built-in simplifications +throughout the formula, and then repeats these two steps (along with +applying the default simplifications) until no further changes are +possible. @cindex @code{ExtSimpRules} variable @cindex @code{UnitSimpRules} variable @@ -27689,7 +27694,7 @@ to hit the apostrophe key every time you wish to enter units. @tindex usimplify The @kbd{u s} (@code{calc-simplify-units}) [@code{usimplify}] command simplifies a units -expression. It uses @kbd{a s} (@code{calc-simplify}) to simplify the +expression. It uses Calc's algebraic simplifications to simplify the expression first as a regular algebraic formula; it then looks for features that can be further simplified by converting one object's units to be compatible with another's. For example, @samp{5 m + 23 mm} will @@ -28773,7 +28778,7 @@ Edit @code{AlgSimpRules}. @xref{Algebraic Simplifications}. @item s D Edit @code{Decls}. @xref{Declarations}. @item s E -Edit @code{EvalRules}. @xref{Limited Simplifications}. +Edit @code{EvalRules}. @xref{Basic Simplifications}. @item s F Edit @code{FitRules}. @xref{Curve Fitting}. @item s G @@ -28943,19 +28948,16 @@ to select the lefthand side, execute your commands, then type All current modes apply when an @samp{=>} operator is computed, including the current simplification mode. Recall that the -formula @samp{x + y + x} is not handled by Calc's default -simplifications, but the @kbd{a s} command will reduce it to -the simpler form @samp{y + 2 x}. You can also type @kbd{m A} -to enable an Algebraic Simplification mode in which the -equivalent of @kbd{a s} is used on all of Calc's results. -If you enter @samp{x + y + x =>} normally, the result will -be @samp{x + y + x => x + y + x}. If you change to -Algebraic Simplification mode, the result will be -@samp{x + y + x => y + 2 x}. However, just pressing @kbd{a s} -once will have no effect on @samp{x + y + x => x + y + x}, +formula @samp{arcsin(sin(x))} will not be handled by Calc's algebraic +simplifications, but Calc's unsafe simplifications will reduce it to +@samp{x}. If you enter @samp{arcsin(sin(x)) =>} normally, the result +will be @samp{arcsin(sin(x)) => arcsin(sin(x))}. If you change to +Extended Simplification mode, the result will be +@samp{arcsin(sin(x)) => x}. However, just pressing @kbd{a e} +once will have no effect on @samp{arcsin(sin(x)) => arcsin(sin(x))}, because the righthand side depends only on the lefthand side and the current mode settings, and the lefthand side is not -affected by commands like @kbd{a s}. +affected by commands like @kbd{a e}. The ``let'' command (@kbd{s l}) has an interesting interaction with the @samp{=>} operator. The @kbd{s l} command evaluates the @@ -33756,8 +33758,9 @@ will be the same as @code{lessp}. But whereas @code{lessp} considers other types of objects to be unordered, @code{beforep} puts any two objects into a definite, consistent order. The @code{beforep} function is used by the @kbd{V S} vector-sorting command, and also -by @kbd{a s} to put the terms of a product into canonical order: -This allows @samp{x y + y x} to be simplified easily to @samp{2 x y}. +by Calc's algebraic simplifications to put the terms of a product into +canonical order: This allows @samp{x y + y x} to be simplified easily to +@samp{2 x y}. @end defun @defun equal x y @@ -34426,10 +34429,9 @@ sub-formula that is @code{eq} to @var{old} replaced by @var{new}. @end defun @defun simplify expr -Simplify the expression @var{expr} by applying various algebraic rules. -This is what the @w{@kbd{a s}} (@code{calc-simplify}) command uses. This -always returns a copy of the expression; the structure @var{expr} points -to remains unchanged in memory. +Simplify the expression @var{expr} by applying Calc's algebraic +simplifications. This always returns a copy of the expression; the +structure @var{expr} points to remains unchanged in memory. More precisely, here is what @code{simplify} does: The expression is first normalized and evaluated by calling @code{normalize}. If any @@ -36562,7 +36564,7 @@ A plain @kbd{C-u} prefix means to prompt for the step size. @c 7 @item A prefix argument specifies simplification level and depth. -1=Default, 2=like @kbd{a s}, 3=like @kbd{a e}. +1=Basic simplifications, 2=Algebraic simplifications, 3=Extended simplifications @c 8 @item diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index c7354edcaf9..dc4bf6400c4 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3146,12 +3146,17 @@ % hopefully nobody will notice/care. \edef\ecsize{\csname\curfontsize ecsize\endcsname}% \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}% - \ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize + \ifmonospace + % typewriter: + \font\thisecfont = ectt\ecsize \space at \nominalsize \else - % regular: - \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \ifx\curfontstyle\bfstylename + % bold: + \font\thisecfont = ecb\ifusingit{i}{x}\ecsize \space at \nominalsize + \else + % regular: + \font\thisecfont = ec\ifusingit{ti}{rm}\ecsize \space at \nominalsize + \fi \fi \thisecfont } diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 680f1921479..898a9994a86 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -126,10 +126,10 @@ directory in @code{user-emacs-directory}, which is normally @section Parsed URLs @cindex parsed URLs The library functions typically operate on @dfn{parsed} versions of -URLs. These are actually vectors of the form: +URLs. These are actually CL structures (vectors) of the form: @example -[@var{type} @var{user} @var{password} @var{host} @var{port} @var{file} @var{target} @var{attributes} @var{full}] +[cl-struct-url @var{type} @var{user} @var{password} @var{host} @var{port} @var{filename} @var{target} @var{attributes} @var{fullness} @var{use-cookies}] @end example @noindent where @@ -144,16 +144,19 @@ is the user password associated with it, or @code{nil}; is the host name associated with it, or @code{nil}; @item port is the port number associated with it, or @code{nil}; -@item file +@item filename is the ``file'' part of it, or @code{nil}. This doesn't necessarily actually refer to a file; @item target is the target part, or @code{nil}; @item attributes is the attributes associated with it, or @code{nil}; -@item full +@item fullness is @code{t} for a fully-specified URL, with a host part indicated by @samp{//} after the scheme part. +@item use-cookies +is @code{nil} to neither send or store cookies to the server, @code{t} +otherwise. @end table @findex url-type @@ -161,23 +164,21 @@ is @code{t} for a fully-specified URL, with a host part indicated by @findex url-password @findex url-host @findex url-port -@findex url-file +@findex url-filename @findex url-target @findex url-attributes -@findex url-full -@findex url-set-type -@findex url-set-user -@findex url-set-password -@findex url-set-host -@findex url-set-port -@findex url-set-file -@findex url-set-target -@findex url-set-attributes -@findex url-set-full +@findex url-fullness These attributes have accessors named @code{url-@var{part}}, where @var{part} is the name of one of the elements above, e.g., -@code{url-host}. Similarly, there are setters of the form -@code{url-set-@var{part}}. +@code{url-host}. These attributes can be set with the same accessors +using @code{setf}: + +@example +(setf (url-port url) 80) +@end example + +If @var{port} is @var{nil}, @code{url-port} returns the default port +of the protocol. There are functions for parsing and unparsing between the string and vector forms. diff --git a/etc/ChangeLog b/etc/ChangeLog index 3d26c9a1351..452a99d2d9b 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,12 @@ +2012-08-09 Chong Yidong + + * images/splash.svg, images/splash.png: Tweak SVG paths to improve + legibility. + +2012-08-08 Dmitry Antipov + + * NEWS: Mention --without-all and --enable-link-time-optimization. + 2012-07-31 Jan Djärv * TODO (NS port): Add text about event loop. diff --git a/etc/NEWS b/etc/NEWS index 93da6f7dccf..a6f6822ab48 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -21,7 +21,13 @@ When you add a new item, please add it without either +++ or --- so we will look at it and add it to the manual. -* Installation Changes in Emacs 24.2 +* Installation Changes in Emacs 24.3 + +** New configure option '--without-all' to disable additonal features. +This disables most of the features that are normally enabled by default. + +** New configure option '--enable-link-time-optimization' to utilize +an appropriate feature provided by GCC since version 4.5.0. ** New configure option '--enable-gcc-warnings', intended for developers. If building with GCC, this enables compile-time checks that warn about @@ -55,7 +61,7 @@ Lisp_Object type no longer uses a union to implement the compile time check that this option enables. -* Startup Changes in Emacs 24.2 +* Startup Changes in Emacs 24.3 ** Emacs no longer searches for `leim-list.el' files beneath the standard lisp/ directory. There should not be any there anyway. If you have @@ -65,7 +71,7 @@ been adding them there, put them somewhere else, eg site-lisp. ** The `--no-site-lisp' command line option now works for Nextstep builds. -* Changes in Emacs 24.2 +* Changes in Emacs 24.3 ** Help changes @@ -110,6 +116,10 @@ treated as images. *** Images displayed via ImageMagick now support transparency and the :background image spec property. +** Internationalization changes + +*** New language environment: Persian. + ** Face underlining can now use a wave. See the "Face Attributes" section of the Elisp manual. @@ -144,8 +154,11 @@ local variables on remote hosts. ** `insert-char' is now a command, and `ucs-insert' an obsolete alias for it. +** The entry for PCL-CVS has been removed from the Tools menu. +The PCL-CVS commands are still available via the keyboard. + -* Editing Changes in Emacs 24.2 +* Editing Changes in Emacs 24.3 ** New option `delete-trailing-lines' specifies whether the M-x delete-trailing-whitespace command should delete trailing lines at the @@ -163,7 +176,7 @@ prompts for a column number. ** `mouse-avoidance-banish-position' can now be used to customize `mouse-avoidance-mode' further. -** `M-=' is now bound to `count-words', not `count-words-region'. +** `C-u M-=' now counts lines/words/characters in the entire buffer. ** `C-M-f' and `C-M-b' will now move to the path name separator character when doing minibuffer filename prompts. @@ -176,7 +189,7 @@ It copies the region-rectangle as the last rectangle kill. ** New input method `vietnamese-vni'. -* Changes in Specialized Modes and Packages in Emacs 24.2 +* Changes in Specialized Modes and Packages in Emacs 24.3 ** Term changes @@ -187,18 +200,32 @@ ANSI terminal colors and styles by customizing the corresponding `term-color-', `term-color-underline' and `term-color-bold' faces. -** CL's main entry is now (require 'cl-lib). +** CL +*** CL's main entry is now (require 'cl-lib). `cl-lib' is like the old `cl' except that it uses the namespace cleanly, -i.e. all its definitions have the "cl-" prefix. +i.e. all its definitions have the "cl-" prefix (and internal definitions use +the "cl--" prefix). If `cl' provided a feature under the name `foo', then `cl-lib' provides it under the name `cl-foo' instead, with the exceptions of the few definitions that had to use `foo*' to avoid conflicts with pre-existing Elisp entities, which have not been renamed to `cl-foo*' but just `cl-foo'. -The old `cl' is now deprecated and is nothing more than a bunch of aliases that +The old `cl' is now deprecated and is just a bunch of aliases that provide the old non-prefixed names. +*** `cl-flet' is not like `flet' (which is deprecated). +Instead it obeys the behavior of Common-Lisp's `flet'. + +*** `cl-labels' is slightly different from `labels'. +The difference is that it relies on the `lexical-binding' machinery (as opposed +to the `lexical-let' machinery used previously) to capture definitions in +closures, so such closures will only work if `lexical-binding' is in use. + +*** `progv' was rewritten to use the `let' machinery. +A side effect is that vars without corresponding value are bound to nil +rather than making them unbound. + ** Desktop *** `desktop-path' no longer includes the "." directory. Desktop @@ -475,9 +502,17 @@ inefficiency, and not namespace-clean. *** cust-print.el -* New Modes and Packages in Emacs 24.2 +* New Modes and Packages in Emacs 24.3 -* Incompatible Lisp Changes in Emacs 24.2 +* Incompatible Lisp Changes in Emacs 24.3 + +** The function `x-select-font' can return a font spec, instead of a +font name as a string. Whether it returns a font spec or a font name +depends on the graphical library. + +** If the NEWTEXT arg to `replace-match' contains a substring "\?", +that substring is inserted literally even if the LITERAL arg is +non-nil, instead of causing an error to be signaled. +++ ** Docstrings starting with `*' no longer indicate user options. @@ -535,10 +570,12 @@ are deprecated and will be removed eventually. *** `last-input-char' and `last-command-char' -* Lisp changes in Emacs 24.2 +* Lisp changes in Emacs 24.3 ** New functions `autoloadp' and `autoload-do-load'. +** New function `posnp' to test if an object is a `posn'. + ** `function-get' fetches the property of a function, following aliases. ** `toggle-read-only' accepts a second argument specifying whether to @@ -558,9 +595,14 @@ The interpretation of the DECLS is determined by `defun-declarations-alist'. ** New error type and new function `user-error'. Doesn't trigger the debugger. -** The functions get-lru-window, get-mru-window and get-largest-window +** Window changes + +*** The functions get-lru-window, get-mru-window and get-largest-window now accept a third argument to avoid choosing the selected window. +*** New display action alist `inhibit-switch-frame', if non-nil, tells +display action functions to avoid changing which frame is selected. + ** Completion *** New function `completion-table-with-quoting' to handle completion @@ -582,7 +624,7 @@ by the underlying C implementation. ** `automount-dir-prefix' is obsolete. ** `buffer-has-markers-at' is obsolete. -* Changes in Emacs 24.2 on non-free operating systems +* Changes in Emacs 24.3 on non-free operating systems ** New configure.bat options on MS-Windows: @@ -593,6 +635,12 @@ is detected. Emacs now supports mouse highlight, help-echo (in the echo area), and mouse-autoselect-window. +** On MS-Windows Vista and later Emacs now supports symbolic links. + +* Changes in Emacs 24.2 + +** This is mainly a bug-fix release. + * Installation Changes in Emacs 24.1 @@ -1161,7 +1209,7 @@ buffer was used. The search is performed using `customize-apropos'. To turn off the search field, set `custom-search-field' to nil. -*** Custom options now start out hidden if at their default values. +*** Options in customize group buffers start out hidden if not customized. Use the arrow to the left of the option name to toggle visibility. *** custom-buffer-sort-alphabetically now defaults to t. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 0f6e0077baf..4edab8a41dc 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -443,8 +443,8 @@ Thus, you could start by adding this to config.h: #define LIBS_SYSTEM -lresolv Then if this gives you an error for redefining a macro, and you see that -the s- file defines LIBS_SYSTEM as -lfoo -lbar, you could change config.h -again to say this: +config.h already defines LIBS_SYSTEM as -lfoo -lbar at some other point +(possibly in an included file) you could change it to say this: #define LIBS_SYSTEM -lresolv -lfoo -lbar diff --git a/etc/TODO b/etc/TODO index 2fcc8a69311..50e3bd64b9d 100644 --- a/etc/TODO +++ b/etc/TODO @@ -18,7 +18,7 @@ to the FSF. "which form of concurrency" we'll want. ** Overhaul of customize: sounds wonderful. ** better support for dynamic embedded graphics: I like this idea (my - mpc.el code could use it for the volume widget), tho I wonder if the + mpc.el code could use it for the volume widget), though I wonder if the resulting efficiency will be sufficient. ** Spread Semantic. ** Improve the "code snippets" support: consolidate skeleton.el, tempo.el, diff --git a/etc/images/splash.png b/etc/images/splash.png index 9d051319c1b..a5331f1dc5a 100644 Binary files a/etc/images/splash.png and b/etc/images/splash.png differ diff --git a/etc/images/splash.svg b/etc/images/splash.svg index 1f1279b9735..ee90dcb243e 100644 --- a/etc/images/splash.svg +++ b/etc/images/splash.svg @@ -22,7 +22,7 @@ along with GNU Emacs. If not, see . --> - + @@ -51,7 +43,7 @@ image/svg+xml - splash + 2008/06/28 @@ -76,59 +68,29 @@ - - - - - + id="stop2552" + style="stop-color:#4c94f1;stop-opacity:0.78431374" + offset="0" /> - - - - + id="stop2554" + style="stop-color:#4c94f1;stop-opacity:0.78431374" + offset="1" /> + id="stop7898" + style="stop-color:#fc644b;stop-opacity:0.78431374" + offset="0" /> + id="stop7900" + style="stop-color:#fc644b;stop-opacity:0.78431374" + offset="1" /> - - - - - - - - - - - - - - - - + + d="m 55.834396,197.41294 c 2.448659,-7.38073 7.446723,-16.72109 12.277833,-22.94475 5.710592,-7.35667 7.378339,-9.3856 28.689891,-34.90319 16.87202,-20.20188 19.22296,-23.17964 22.55476,-28.56842 1.5428,-2.49527 3.17766,-4.53686 3.63304,-4.53686 1.18186,0 1.10043,0.30992 -1.63307,6.21531 -1.35357,2.92423 -2.46105,5.64532 -2.46105,6.04685 0,0.40153 -2.97647,4.90375 -6.6144,10.00493 -8.98843,12.60381 -10.76025,14.97182 -13.0823,17.48445 -1.0981,1.18822 -3.8535,4.49366 -6.123108,7.34539 -2.269606,2.85173 -4.587188,5.62332 -5.150194,6.15909 -0.562997,0.53575 -2.795585,3.19769 -4.961309,5.91542 -6.691216,8.39667 -16.095209,19.83397 -17.431654,21.20066 -0.699773,0.71561 -3.044271,3.91702 -5.209995,7.11426 -4.16128,6.14322 -5.795033,7.40513 -4.488444,3.46686 z m 66.481544,-23.7645 c 0.22279,-0.5941 1.5292,-4.28446 2.90315,-8.20081 3.44555,-9.82127 13.66236,-27.15831 19.73886,-33.49506 l 2.48602,-2.59251 2.25191,2.37646 c 2.67739,2.82544 3.88298,2.92759 8.02572,0.68 3.08741,-1.67502 7.69643,-8.22076 20.10229,-28.54928 4.55053,-7.456586 5.01229,-7.939498 5.0346,-5.26516 0.0415,4.9808 -22.21528,41.2544 -29.34472,47.82522 -4.11732,3.7947 -6.18823,4.04757 -8.84718,1.0802 -1.06473,-1.18822 -2.3151,-2.15972 -2.77861,-2.15886 -1.62142,0.003 -12.08302,16.59943 -16.47702,26.13939 -0.82094,1.78235 -1.9443,3.24062 -2.49635,3.24062 -0.55207,0 -0.82147,-0.48609 -0.59867,-1.08021 z m 84.19319,-24.88787 c 0,-7.49007 7.66313,-38.06798 12.33356,-49.21415 3.04458,-7.266009 7.33463,-20.847085 8.32578,-26.356986 0.42748,-2.376449 1.49075,-7.626245 2.36285,-11.666209 0.87207,-4.039964 1.5862,-11.563 1.58694,-16.717855 0.002,-10.935036 -1.20271,-13.589976 -7.10476,-15.663026 -7.62736,-2.67905 -10.16765,-1.47291 -13.00198,6.173428 -1.74243,4.700723 -3.72352,6.856253 -5.44369,5.923006 -1.89626,-1.028794 -1.05403,-4.387566 2.90016,-11.565454 8.13973,-14.77576 14.55936,-18.45654 24.45815,-14.02345 5.65324,2.53175 9.02208,8.60392 9.02208,16.2618 0,9.333563 -7.01946,35.141105 -14.28285,52.511886 -4.47563,10.703728 -11.5668,35.30103 -14.85507,51.5282 -2.1002,10.36421 -3.15113,13.73222 -4.51891,14.48205 -1.5746,0.86323 -1.78226,0.66827 -1.78226,-1.67324 z M 110.03525,94.607887 c -7.1e-4,-8.464568 -0.25892,-9.796146 -2.81265,-14.505144 -2.66535,-4.914782 -7.28206,-9.937882 -9.13385,-9.937882 -0.4676,0 -0.85017,-0.490243 -0.85017,-1.08943 0,-1.557732 8.70129,-12.737188 9.91372,-12.737188 1.73907,0 7.4566,5.456815 9.50728,9.073719 2.60567,4.595744 3.35771,11.337596 2.2795,20.434785 -0.9601,8.100583 -4.13995,15.843563 -7.07234,17.221213 -1.73206,0.81373 -1.83075,0.3578 -1.83149,-8.460073 z m -69.268036,2.283327 c -3.977291,-2.746359 -3.44557,-6.261434 2.439644,-16.127646 4.970535,-8.33282 10.094017,-15.38029 21.43897,-29.489855 6.601357,-8.209992 8.637667,-10.20312 9.579511,-9.376336 0.799394,0.701746 -2.618999,5.390153 -11.474198,15.737111 -16.940162,19.79395 -18.734332,27.221155 -6.575701,27.221155 3.304542,0 6.058837,-0.617002 8.461092,-1.895408 6.360466,-3.38485 18.203678,-11.286415 23.507089,-15.683501 2.848527,-2.361722 5.456729,-4.05036 5.795999,-3.752528 1.04524,0.917548 -4.907057,10.147668 -7.816978,12.121655 -1.511589,1.025416 -5.874113,4.197632 -9.69449,7.049372 -3.820388,2.85174 -8.563965,6.157166 -10.541309,7.345392 -1.977334,1.188224 -4.400156,2.796969 -5.384044,3.574986 -2.248219,1.777799 -11.920783,5.066639 -14.901091,5.066639 -1.232383,0 -3.407898,-0.80597 -4.834494,-1.791036 z M 167.35901,63.639316 c -4.35468,-2.677534 -4.37646,-3.982873 -0.1931,-11.57676 l 3.90554,-7.089571 2.54785,2.658058 c 3.02363,3.154415 6.72598,3.451472 12.70923,1.019721 4.8079,-1.95406 8.30397,-5.194275 11.75211,-10.892036 l 2.61484,-4.320814 -0.49413,3.334678 c -0.73833,4.982504 -10.09007,19.207325 -14.90376,22.669936 -7.26038,5.222576 -13.78694,6.749482 -17.93858,4.196788 z m -32.7125,-5.536491 c -1.89501,-0.888629 -8.4802,-6.332726 -14.63377,-12.09799 -11.53272,-10.804983 -19.30559,-15.591501 -25.31921,-15.591501 -4.300218,0 -9.890682,3.33457 -11.790334,7.032628 -2.74495,5.343604 -3.950075,5.711001 -6.196765,1.88915 -3.156098,-5.368868 -12.746669,-12.378428 -16.936324,-12.378428 -0.628489,0 -6.188212,4.49121 -12.354949,9.980456 -11.483232,10.221671 -16.718945,13.296629 -22.701995,13.33298 -3.490867,0.0212 -7.744061,-2.699113 -10.336357,-6.611093 -1.586521,-2.394192 -1.546221,-2.69169 1.094758,-8.081731 1.508064,-3.077822 3.079193,-6.373792 3.491421,-7.324372 0.652211,-1.50398 0.990788,-1.25829 2.608443,1.8928 1.911186,3.72288 6.321032,7.180923 9.157411,7.180923 4.150835,0 11.504527,-4.724593 21.3988,-13.748293 9.555236,-8.71448 10.829873,-9.58412 14.047538,-9.58412 4.293595,0 9.556372,2.77633 14.656374,7.73182 2.069449,2.0108 3.86226,3.5242 3.984029,3.36311 0.12178,-0.16109 0.945137,-1.31084 1.829667,-2.55499 0.88453,-1.24416 3.685604,-3.3308 6.224606,-4.63699 3.686737,-1.89664 5.463317,-2.29109 8.822097,-1.95876 6.8491,0.67769 15.00978,5.73859 25.22338,15.64246 9.22954,8.949677 17.70147,14.387397 22.41549,14.387397 3.79377,0 9.50175,-3.242454 12.44138,-7.067419 2.42259,-3.152211 2.91825,-3.453173 3.17838,-1.929873 0.1695,0.992615 -1.28406,4.871896 -3.23015,8.620627 -3.35987,6.472087 -6.91202,10.130201 -12.7132,13.092455 -3.04983,1.557333 -10.43785,1.258306 -14.36072,-0.581246 z" + style="opacity:1;fill:#000000;display:inline" /> + style="display:inline"> + d="m 57.534816,196.31319 c 2.448659,-7.38073 7.446723,-16.72109 12.277833,-22.94475 5.710592,-7.35667 7.378339,-9.3856 28.689891,-34.90319 16.87202,-20.20188 19.22296,-23.17964 22.55476,-28.56842 1.5428,-2.49527 3.17766,-4.53686 3.63304,-4.53686 1.18186,0 1.10043,0.30992 -1.63307,6.21531 -1.35357,2.92423 -2.46105,5.64532 -2.46105,6.04685 0,0.40153 -2.97647,4.90375 -6.6144,10.00493 -8.98843,12.60381 -10.76025,14.97182 -13.0823,17.48445 -1.0981,1.18822 -3.8535,4.49366 -6.123108,7.34539 -2.269606,2.85173 -4.587188,5.62332 -5.150194,6.15909 -0.562997,0.53575 -2.795585,3.19769 -4.961309,5.91542 -6.691216,8.39667 -16.095209,19.83397 -17.431654,21.20066 -0.699773,0.71561 -3.044271,3.91702 -5.209995,7.11426 -4.16128,6.14322 -5.795033,7.40513 -4.488444,3.46686 z m 66.481544,-23.7645 c 0.22279,-0.5941 1.5292,-4.28446 2.90315,-8.20081 3.44555,-9.82127 13.66236,-27.15831 19.73886,-33.49506 l 2.48602,-2.59251 2.25191,2.37646 c 2.67739,2.82544 3.88298,2.92759 8.02572,0.68 3.08741,-1.67502 7.69643,-8.22076 20.10229,-28.54928 4.55053,-7.45659 5.01229,-7.939502 5.0346,-5.26516 0.0415,4.9808 -22.21528,41.2544 -29.34472,47.82522 -4.11732,3.7947 -6.18823,4.04757 -8.84718,1.0802 -1.06473,-1.18822 -2.3151,-2.15972 -2.77861,-2.15886 -1.62142,0.003 -12.08302,16.59943 -16.47702,26.13939 -0.82094,1.78235 -1.9443,3.24062 -2.49635,3.24062 -0.55207,0 -0.82147,-0.48609 -0.59867,-1.08021 z m 84.19319,-24.88787 c 0,-7.49007 7.66313,-38.06798 12.33356,-49.21415 3.04458,-7.266013 7.33463,-20.847089 8.32578,-26.35699 0.42748,-2.376449 1.49075,-7.626245 2.36285,-11.666209 0.87207,-4.039964 1.5862,-11.563 1.58694,-16.717855 0.002,-10.935036 -1.20271,-13.589976 -7.10476,-15.663026 -7.62736,-2.67905 -10.16765,-1.47291 -13.00198,6.173428 -1.74243,4.700723 -3.72352,6.856253 -5.44369,5.923006 -1.89626,-1.028794 -1.05403,-4.387566 2.90016,-11.565454 8.13973,-14.77576 14.55936,-18.45654 24.45815,-14.02345 5.65324,2.53175 9.02208,8.60392 9.02208,16.2618 0,9.333563 -7.01946,35.141105 -14.28285,52.511886 -4.47563,10.703728 -11.5668,35.301034 -14.85507,51.528204 -2.1002,10.36421 -3.15113,13.73222 -4.51891,14.48205 -1.5746,0.86323 -1.78226,0.66827 -1.78226,-1.67324 z M 111.73567,93.508133 c -7.1e-4,-8.464568 -0.25892,-9.796146 -2.81265,-14.505144 -2.66535,-4.914782 -7.28206,-9.937882 -9.13385,-9.937882 -0.4676,0 -0.85017,-0.490243 -0.85017,-1.08943 0,-1.557732 8.70129,-12.737188 9.91372,-12.737188 1.73907,0 7.4566,5.456815 9.50728,9.073719 2.60567,4.595744 3.35771,11.337596 2.2795,20.434785 -0.9601,8.100583 -4.13995,15.843567 -7.07234,17.221217 -1.73206,0.81373 -1.83075,0.3578 -1.83149,-8.460077 z M 42.467634,95.79146 c -3.977291,-2.746359 -3.44557,-6.261434 2.439644,-16.127646 4.970535,-8.33282 10.094017,-15.38029 21.43897,-29.489855 6.601357,-8.209992 8.637667,-10.20312 9.579511,-9.376336 0.799394,0.701746 -2.618999,5.390153 -11.474198,15.737111 -16.940162,19.79395 -18.734332,27.221155 -6.575701,27.221155 3.304542,0 6.058837,-0.617002 8.461092,-1.895408 6.360466,-3.38485 18.203678,-11.286415 23.507089,-15.683501 2.848527,-2.361722 5.456729,-4.05036 5.795999,-3.752528 1.04524,0.917548 -4.907057,10.147668 -7.816978,12.121655 -1.511589,1.025416 -5.874113,4.197632 -9.69449,7.049372 -3.820388,2.85174 -8.563965,6.157166 -10.541309,7.345392 -1.977334,1.188224 -4.400156,2.796969 -5.384044,3.574986 C 59.955,94.293656 50.282436,97.5825 47.302128,97.5825 c -1.232383,0 -3.407898,-0.80597 -4.834494,-1.79104 z M 169.05943,62.539562 c -4.35468,-2.677534 -4.37646,-3.982873 -0.1931,-11.57676 l 3.90554,-7.089571 2.54785,2.658058 c 3.02363,3.154415 6.72598,3.451472 12.70923,1.019721 4.8079,-1.95406 8.30397,-5.194275 11.75211,-10.892036 l 2.61484,-4.320814 -0.49413,3.334678 c -0.73833,4.982504 -10.09007,19.207325 -14.90376,22.669936 -7.26038,5.222576 -13.78694,6.749482 -17.93858,4.196788 z m -32.7125,-5.536491 c -1.89501,-0.888629 -8.4802,-6.332726 -14.63377,-12.09799 C 110.18044,34.100098 102.40757,29.31358 96.39395,29.31358 c -4.300218,0 -9.890682,3.33457 -11.790334,7.032628 -2.74495,5.343604 -3.950075,5.711001 -6.196765,1.88915 C 75.250753,32.86649 65.660182,25.85693 61.470527,25.85693 c -0.628489,0 -6.188212,4.49121 -12.354949,9.980456 -11.483232,10.221671 -16.718945,13.296629 -22.701995,13.33298 -3.490867,0.0212 -7.744061,-2.699113 -10.336357,-6.611093 -1.586521,-2.394192 -1.546221,-2.69169 1.094758,-8.081731 1.508064,-3.077822 3.079193,-6.373792 3.491421,-7.324372 0.652211,-1.50398 0.990788,-1.25829 2.608443,1.8928 1.911186,3.72288 6.321032,7.180923 9.157411,7.180923 4.150835,0 11.504527,-4.724593 21.3988,-13.748293 9.555236,-8.71448 10.829873,-9.58412 14.047538,-9.58412 4.293595,0 9.556372,2.77633 14.656374,7.73182 2.069449,2.0108 3.86226,3.5242 3.984029,3.36311 0.12178,-0.16109 0.945137,-1.31084 1.829667,-2.55499 0.88453,-1.24416 3.685604,-3.3308 6.224606,-4.63699 3.686737,-1.89664 5.463317,-2.29109 8.822097,-1.95876 6.8491,0.67769 15.00978,5.73859 25.22338,15.64246 9.22954,8.949677 17.70147,14.387397 22.41549,14.387397 3.79377,0 9.50175,-3.242454 12.44138,-7.067419 2.42259,-3.152211 2.91825,-3.453173 3.17838,-1.929873 0.1695,0.992615 -1.28406,4.871896 -3.23015,8.620627 -3.35987,6.472087 -6.91202,10.130201 -12.7132,13.092455 -3.04983,1.557333 -10.43785,1.258306 -14.36072,-0.581246 z" + style="fill:url(#linearGradient2425);fill-opacity:1;stroke:#000000;stroke-width:0.97730815" /> + diff --git a/leim/ChangeLog b/leim/ChangeLog index cafaf5a9eb1..fcf0e72c3f4 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,8 @@ +2012-08-06 Mohsen BANAN + + * quail/persian.el: Add some mappings. (Bug#11812) + (farsi-isiri-9147, farsi-transliterate-banan): Doc fixes. + 2012-07-30 Paul Eggert Update .PHONY listings in makefiles. diff --git a/leim/quail/hangul.el b/leim/quail/hangul.el index c66c47b47fc..fd1dc0d2954 100644 --- a/leim/quail/hangul.el +++ b/leim/quail/hangul.el @@ -532,7 +532,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'." (define-obsolete-function-alias 'hangul-input-method-inactivate - 'hangul-input-method-deactivate "24.2") + 'hangul-input-method-deactivate "24.3") (defun hangul-input-method-help () "Describe the current Hangul input method." diff --git a/leim/quail/persian.el b/leim/quail/persian.el index 70e2d380329..f4e74011ad8 100644 --- a/leim/quail/persian.el +++ b/leim/quail/persian.el @@ -1,9 +1,9 @@ ;;; persian.el --- Quail package for inputting Persian/Farsi keyboard -*- coding: utf-8;-*- -;; Copyright (C) 2011-2012 Free Software Foundation, Inc. +;; Copyright (C) 2011-2012 Free Software Foundation, Inc. -;; Author: Mohsen BANAN -;; http://mohsen.1.banan.byname.net/contact +;; Author: Mohsen BANAN +;; X-URL: http://mohsen.1.banan.byname.net/contact ;; Keywords: multilingual, input method, Farsi, Persian, keyboard @@ -22,8 +22,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;; This is a Halaal Poly-Existential intended to remain perpetually Halaal. - ;;; Commentary: ;; ;; This file contains a collection of input methods for @@ -31,7 +29,7 @@ ;; ;; At this time, the following input methods are specified: ;; -;; - (farsi-isiri-9149) Persian Keyboard based on Islamic Republic of Iran's ISIR-9147 +;; - (farsi-isiri-9149) Persian Keyboard based on Islamic Republic of Iran's ISIRI-9147 ;; - (farsi-transliterate-banan) An intuitive transliteration keyboard for Farsi ;; ;; Additional documentation for these input methods can be found at: @@ -50,18 +48,26 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; The keyboard mapping defined here is based on: +;; فنّاوریِ اطلاعات - چیدمان حروف و علائم فارسی بر صفحه کلید رایانه +;; استاندارد ملی ایران ۹۱۴۷ − چاپ اول ;; ;; Institute of Standards and Industrial Research of Iran ;; Information Technology – Layout of Persian Letters and Symbols ;; on Computer Keyboards ;; ISIRI 9147 -- 1st edition -;; http://www.isiri.org/UserStd/DownloadStd.aspx?id=9147 +;; Published at: http://www.isiri.org/portal/files/std/9147.pdf +;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-9147 ;; -;; The specification is also republished at -;; http://www.farsiweb.ir/wiki/Image:Isiri-9147.pdf -;; and various other sites. ;; -;; ISIRI-6219 is also relevant. +;; Specification of Iran's Persian Character Set is also relevant: +;; فنّاوریِ اطلاعات -- تبادل و شیوه‌ی نمایش اطلاعاتِ فارسی بر اساس یونی کُد +;; استاندارد ملی ایران ۶۲۱۹ −− نسخهی نهایی +;; +;; Institute of Standards and Industrial Research of Iran +;; Information Technology – Persian Information Interchange and Display Mechanism, using Unicode +;; ISIRI-6219 Final Version +;; Published at: http://www.isiri.org/portal/files/std/6219.htm +;; Re-Published at: http://www.persoarabic.org/Repub/fpf-isiri-6219 ;; ;; Layers 1, 2 and 3 of ISIRI-9147 are fully implemented with the ;; exception of the Backslash, Alt-Backslash, Shift-Space and @@ -92,10 +98,10 @@ (quail-define-package - "farsi-isiri-9147" "Farsi" " ف" nil "Farsi input method. - -Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. -" nil t t t t nil nil nil nil nil t) + "farsi-isiri-9147" "Persian" " ف" nil + "Farsi keyboard based on ISIRI-9147. + See http://www.persoarabic.org/PLPC/120036 for additional documentation." + nil t t t t nil nil nil nil nil t) ;; Note: the rows of keys below are enclosed in Left-To-Right Override ;; embedding, to prevent them from being reordered by the Emacs @@ -305,11 +311,11 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ;; ;; For some persian characters there are multiple ways of inputting ;; the same character. For example both ``i'' and ``y'' produce ی. -;; For یک ``yk'', ``y'' is more natural and for این ``ain'', ``i'' is more natural. +;; For یک ``yk'', ``y'' is more natural and for این ``ain'', ``i'' is more natural. ;; ;; The more frequently used keys are mapped to lower case. The less frequently used letter moves to -;; upper case. For example: ``s'' is س and ``S'' is ص. ``h'' is ح and ``H'' -;; is ه. +;; upper case. For example: ``s'' is س and ``S'' is ص. ``h'' is ه and ``H'' +;; is ح. ;; ;; Multi-character input is based on \, &, and / prefix ;; characters. The letter 'h' is used as a postfix for the following two character mappings: @@ -317,29 +323,30 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ;; ;; ;; Prefix letter \ is used for two character inputs when an alternate form of a letter -;; is desired for example \% is: ‌÷ when % is: ٪. +;; is desired for example '\-' is: '÷' when '-' is: '-'. ;; ;; Prefix letter & is used for multi-character inputs when special characters are ;; desired based on their abbreviate name. For example you can enter ‎ to enter the ;; ``LEFT-TO-RIGHT MARK'' character. ;; -;; Prefix letter / is used to provide two characters. / is: ``ZERO WIDTH NON-JOINER'' +;; Prefix letter / is used to provide two characters. / is: ``ZERO WIDTH NON-JOINER'' ;; and // is /. ;; ;; The letter 'h' is used in a number of two character postfix mappings, ;; for example ``sh'' ش. So if you need the sequence of ``s'' and ``h'' you -;; need to repeat the ``s''. For example: سحر = 's' 's' 'h' 'r'. +;; need to repeat the ``s''. For example: سهم = 's' 's' 'h' 'm'. ;; (quail-define-package - "farsi-transliterate-banan" "Farsi" "ب" t + "farsi-transliterate-banan" "Persian" "ب" t "Intuitive transliteration keyboard layout for persian/farsi. -" nil t t t t nil nil nil nil nil t) + See http://www.persoarabic.org/PLPC/120036 for additional documentation." + nil t t t t nil nil nil nil nil t) (quail-define-rules -;;;;;;;;;;; isiri-6219 Table 5 -- جدول ۵ - حروِفِ اصلیِ فارسی +;;;;;;;;;;; isiri-6219 Table 5 -- جدول ۵ - حروِفِ اصلیِ فارسی ("W" ?ء) ;; hamzeh ("A" ?آ) ;; U+0622 & ARABIC LETTER ALEF WITH MADDA ABOVE & الف با کلاه ("a" ?ا) ;; U+0627 & ARABIC LETTER ALEF & الف @@ -352,7 +359,8 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("cc" ?ث) ("j" ?ج) ("ch" ?چ) - ("h" ?ح) + ("H" ?ح) + ("hh" ?ح) ("kh" ?خ) ("d" ?د) ("Z" ?ذ) @@ -370,6 +378,9 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("X" ?ظ) ("w" ?ع) ("q" ?غ) + ("G" ?غ) + ("Gh" ?غ) + ("GG" ?غ) ("f" ?ف) ("Q" ?ق) ("gh" ?ق) @@ -383,13 +394,13 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("v" ?و) ("u" ?و) ("V" ?ؤ) - ("H" ?ه) + ("h" ?ه) ("y" ?ی) ("i" ?ی) ("I" ?ئ) -;;;;;;;;;;; isiri-6219 Table 6 -- جدول ۶ - حروِفِ عربی +;;;;;;;;;;; isiri-6219 Table 6 -- جدول ۶ - حروِفِ عربی ("F" ?إ) ("D" ?\u0671) ;; (ucs-insert #x0671)ٱ named: حرفِ الفِ وصل ("K" ?ك) ;; Arabic kaf @@ -416,8 +427,8 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("+" ?\u002B) ;; (ucs-insert #x002B)+ named: علامتِ به‌اضافه ("-" ?\u2212) ;; (ucs-insert #x2212)− named: علامتِ منها ("\\*" ?\u00D7) ;; (ucs-insert #x00D7)× named: علامتِ ضرب - ("\\%" ?\u007F) ;; (ucs-insert #x00F7)÷ named: علامتِ تقسیم - ("<" ?\u003C) ;; (ucs-insert #x003C)< named: علامتِ کوچکتر + ("\\-" ?\u00F7) ;; (ucs-insert #x00F7)÷ named: علامتِ تقسیم + ("<" ?\u003C) ;; (ucs-insert #x003C)< named: علامتِ کوچکتر ("=" ?\u003D) ;; (ucs-insert #x003D)= named: علامتِ مساوی (">" ?\u003E) ;; (ucs-insert #x003E)> named: علامتِ بزرگتر @@ -425,24 +436,25 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ;;;;;;;;;;; isiri-6219 Table 2 -- جدول ۲ - علائم نقطه گذاریِ مشترک ;;; Space ("." ?.) ;; - (":" ?\u003A) ;; (ucs-insert #x003A): named: - ("!" ?\u0021) ;; (ucs-insert #x0021)! named: - ("\\." ?\u2026) ;; (ucs-insert #x2026)… named: - ("\\-" ?\u2010) ;; (ucs-insert #x2010)‐ named: - ("-" ?\u002D) ;; (ucs-insert #x002D)- named: + (":" ?\u003A) ;; (ucs-insert #x003A): named: + ("!" ?\u0021) ;; (ucs-insert #x0021)! named: + ("\\." ?\u2026) ;; (ucs-insert #x2026)… named: + ("\\-" ?\u2010) ;; (ucs-insert #x2010)‐ named: + ("-" ?\u002D) ;; (ucs-insert #x002D)- named: ("|" ?|) ;;("\\\\" ?\) ("//" ?/) - ("*" ?\u002A) ;; (ucs-insert #x002A)* named: - ("(" ?\u0028) ;; (ucs-insert #x0028)( named: - (")" ?\u0029) ;; (ucs-insert #x0029)) named: - ("[" ?\u005B) ;; (ucs-insert #x005B)[ named: - ("[" ?\u005D) ;; (ucs-insert #x005D)] named: - ("{" ?\u007B) ;; (ucs-insert #x007B){ named: - ("}" ?\u007D) ;; (ucs-insert #x007D)} named: - ("\\<" ?\u00AB) ;; (ucs-insert #x00AB)« named: - ("\\>" ?\u00BB) ;; (ucs-insert #x00BB)» named: - + ("*" ?\u002A) ;; (ucs-insert #x002A)* named: + ("(" ?\u0028) ;; (ucs-insert #x0028)( named: + (")" ?\u0029) ;; (ucs-insert #x0029)) named: + ("[" ?\u005B) ;; (ucs-insert #x005B)[ named: + ("[" ?\u005D) ;; (ucs-insert #x005D)] named: + ("{" ?\u007B) ;; (ucs-insert #x007B){ named: + ("}" ?\u007D) ;; (ucs-insert #x007D)} named: + ("\\<" ?\u00AB) ;; (ucs-insert #x00AB)« named: + ("\\>" ?\u00BB) ;; (ucs-insert #x00BB)» named: + ("N" ?\u00AB) ;; (ucs-insert #x00AB)« named: + ("M" ?\u00BB) ;; (ucs-insert #x00BB)» named: ;;;;;;;;;;; isiri-6219 Table 3 -- جدول ۳ - علائم نقطه گذاریِ فارسی ("," ?،) ;; farsi @@ -455,9 +467,9 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ;; LF ;; CR ("‌" ?\u200C) ;; (ucs-insert #x200C)‌ named: فاصله‌ی مجازی - ("/" ?\u200C) ;; + ("/" ?\u200C) ;; ("‍" ?\u200D) ;; (ucs-insert #x200D)‍ named: اتصالِ مجازی - ("J" ?\u200D) ;; + ("J" ?\u200D) ;; ("‎" ?\u200E) ;; (ucs-insert #x200E)‎ named: نشانه‌ی چپ‌به‌راست ("‏" ?\u200F) ;; (ucs-insert #x200F)‏ named: نشانه‌ی راست‌به‌چپ ("&ls;" ?\u2028) ;; (ucs-insert #x2028)
 named: جداکننده‌ی سطرها @@ -468,7 +480,7 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("&lro;" ?\u202D) ;; (ucs-insert #x202D) named: زیرمتنِ اکیداً چپ‌به‌راست ("&rlo;" ?\u202D) ;; (ucs-insert #x202E) named: زیرمتنِ اکیداً راست‌به‌چپ ("&bom;" ?\uFEFF) ;; (ucs-insert #xFEFF) named: نشانه‌ی ترتیبِ بایت‌ها - + ;;;;;;;;;;; isiri-6219 Table 7 -- جدول ۷ - نشانه‌هایِ فارسی ("^" ?َ) ;; zbar ;; زبر فارسى @@ -481,12 +493,12 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("@" ?ْ) ;; ساکن فارسى ("U" ?\u0653) ;; (ucs-insert #x0653)ٓ named: مدِ فارسی ("`" ?ٔ) ;; همزه فارسى بالا - ("C" ?\u0655) ;; (ucs-insert #x0655)ٕ named: همزه فارسى پایین + ("C" ?\u0655) ;; (ucs-insert #x0655)ٕ named: همزه فارسى پایین ("$" ?\u0670) ;; (ucs-insert #x0670)ٰ named: الفِ مقصوره‌ی فارسی ;;;;;;;;;;; isiri-6219 Table 8 - Forbidden Characters -- جدول ۸ - نویسه‌هایِ ممنوع -;; ;; he ye (ucs-insert 1728) kills emacs-24.0.90 +;; ;; he ye (ucs-insert 1728) (ucs-insert #x06c0) kills emacs-24.0.90 ;; arabic digits 0-9 @@ -496,7 +508,7 @@ Based on ISIRI-9147 Layout of Persian Letters and Symbols on Computer Keyboards. ("\\~" ?~) ("\\@" ?@) ("\\#" ?#) - ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named: + ("\\$" ?\uFDFC) ;; (ucs-insert #xFDFC)﷼ named: ("\\^" ?^) ("\\1" ?1) ("\\2" ?2) diff --git a/leim/quail/uni-input.el b/leim/quail/uni-input.el index 1cab31f83bb..7946c08e9e5 100644 --- a/leim/quail/uni-input.el +++ b/leim/quail/uni-input.el @@ -114,7 +114,7 @@ While this input method is active, the variable (define-obsolete-function-alias 'ucs-input-inactivate - 'ucs-input-deactivate "24.2") + 'ucs-input-deactivate "24.3") (defun ucs-input-help () (interactive) diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index c5d6ed6eaf0..f3fd3751005 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,54 @@ +2012-08-15 Paul Eggert + + * etags.c (Pascal_functions): Fix parenthesization typo. + +2012-08-14 Paul Eggert + + * make-docfile.c (enum global_type): Sort values roughly in + decreasing alignment, except put functions last. + (compare_globals): Use this new property of enum global_type. + (write_globals): Use bool, not int, for booleans. + +2012-08-10 Glenn Morris + + * make-docfile.c (IF_LINT): + * emacsclient.c (IF_LINT): Remove (in config.h now). + + * make-docfile.c (main): + (fopen) [!WINDOWSNT]: + (chdir) [!DOS_NT]: No more need to undef. + + * movemail.c (DIRECTORY_SEP, IS_DIRECTORY_SEP): + * make-docfile.c (DIRECTORY_SEP, IS_DIRECTORY_SEP): + * emacsclient.c (DIRECTORY_SEP, IS_DIRECTORY_SEP, IS_DEVICE_SEP): + Remove (they are in config.h now). + + * ebrowse.c (PATH_LIST_SEPARATOR): + Remove, and replace with SEPCHAR from config.h. + +2012-08-03 Juanma Barranquero + + * makefile.w32-in (LOCAL_FLAGS): Remove WINDOWSNT and DOS_NT, + they are always defined in config.h. + +2012-08-03 Eli Zaretskii + + * ntlib.c (lstat): New function, calls 'stat'. + +2012-08-02 Paul Eggert + + Use C99-style 'extern inline' if available. + * profile.c (SYSTIME_INLINE): Define. + +2012-08-02 Glenn Morris + + * makefile.w32-in (MS_W32_H): Update for new ms-w32.h location. + +2012-08-01 Glenn Morris + + * Makefile.in (config_h): New variable. + Use throughout in place of ../src/config.h. + 2012-08-01 Juanma Barranquero * makefile.w32-in (CONFIG_H): Update dependencies. diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index a578966b0f0..c5acca28856 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -178,6 +178,9 @@ ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} LINK_CFLAGS = ${BASE_CFLAGS} ${LDFLAGS} ${CFLAGS} CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS} +# Configuration files for .o files to depend on. +config_h = ../src/config.h $(srcdir)/../src/conf_post.h + all: ${EXE_FILES} ${SCRIPTS} ${INSTALLABLE_SCRIPTS} .PHONY: all need-blessmail maybe-blessmail @@ -289,19 +292,19 @@ test-distrib${EXEEXT}: ${srcdir}/test-distrib.c $(CC) ${ALL_CFLAGS} -o test-distrib ${srcdir}/test-distrib.c ./test-distrib ${srcdir}/testfile -../lib/libgnu.a: ../src/config.h +../lib/libgnu.a: $(config_h) cd ../lib && $(MAKE) libgnu.a -regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h ../src/config.h +regex.o: $(srcdir)/../src/regex.c $(srcdir)/../src/regex.h $(config_h) ${CC} -c ${CPP_CFLAGS} -DCONFIG_BROKETS -DINHIBIT_STRING_HEADER \ ${srcdir}/../src/regex.c -etags${EXEEXT}: ${srcdir}/etags.c regex.o ../src/config.h +etags${EXEEXT}: ${srcdir}/etags.c regex.o $(config_h) $(CC) ${ALL_CFLAGS} -DEMACS_NAME="\"GNU Emacs\"" \ -DVERSION="\"${version}\"" ${srcdir}/etags.c \ regex.o $(LOADLIBES) -o etags -ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h ../src/config.h +ebrowse${EXEEXT}: ${srcdir}/ebrowse.c ${srcdir}/../lib/min-max.h $(config_h) $(CC) ${ALL_CFLAGS} -DVERSION="\"${version}\"" \ ${srcdir}/ebrowse.c $(LOADLIBES) -o ebrowse @@ -312,30 +315,30 @@ ctags${EXEEXT}: etags${EXEEXT} -DVERSION="\"${version}\"" ${srcdir}/etags.c \ regex.o $(LOADLIBES) -o ctags -profile${EXEEXT}: ${srcdir}/profile.c ../src/config.h +profile${EXEEXT}: ${srcdir}/profile.c $(config_h) $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c \ $(LOADLIBES) $(LIB_CLOCK_GETTIME) -o profile -make-docfile${EXEEXT}: ${srcdir}/make-docfile.c ../src/config.h +make-docfile${EXEEXT}: ${srcdir}/make-docfile.c $(config_h) $(CC) ${ALL_CFLAGS} ${srcdir}/make-docfile.c $(LOADLIBES) \ -o make-docfile -movemail${EXEEXT}: ${srcdir}/movemail.c pop.o ../src/config.h +movemail${EXEEXT}: ${srcdir}/movemail.c pop.o $(config_h) $(CC) ${ALL_CFLAGS} ${MOVE_FLAGS} ${srcdir}/movemail.c pop.o \ $(LOADLIBES) $(LIBS_MOVE) -o movemail -pop.o: ${srcdir}/pop.c ${srcdir}/../lib/min-max.h ../src/config.h +pop.o: ${srcdir}/pop.c ${srcdir}/../lib/min-max.h $(config_h) $(CC) -c ${CPP_CFLAGS} ${MOVE_FLAGS} ${srcdir}/pop.c -emacsclient${EXEEXT}: ${srcdir}/emacsclient.c ../src/config.h +emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(config_h) $(CC) ${ALL_CFLAGS} ${srcdir}/emacsclient.c \ -DVERSION="\"${version}\"" \ $(LOADLIBES) -o emacsclient -hexl${EXEEXT}: ${srcdir}/hexl.c ../src/config.h +hexl${EXEEXT}: ${srcdir}/hexl.c $(config_h) $(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o hexl -update-game-score${EXEEXT}: ${srcdir}/update-game-score.c ../src/config.h +update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(config_h) $(CC) ${ALL_CFLAGS} -DHAVE_SHARED_GAME_DIR="\"$(gamedir)\"" \ ${srcdir}/update-game-score.c $(LOADLIBES) -o update-game-score diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 1c43bc6a4f1..f8569fe3747 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -43,17 +43,12 @@ along with GNU Emacs. If not, see . */ #define READ_CHUNK_SIZE (100 * 1024) -/* The character used as a separator in path lists (like $PATH). */ - #if defined (__MSDOS__) -#define PATH_LIST_SEPARATOR ';' #define FILENAME_EQ(X,Y) (strcasecmp (X,Y) == 0) #else #if defined (WINDOWSNT) -#define PATH_LIST_SEPARATOR ';' #define FILENAME_EQ(X,Y) (stricmp (X,Y) == 0) #else -#define PATH_LIST_SEPARATOR ':' #define FILENAME_EQ(X,Y) (streq (X,Y)) #endif #endif @@ -3417,7 +3412,7 @@ add_search_path (char *path_list) char *start = path_list; struct search_path *p; - while (*path_list && *path_list != PATH_LIST_SEPARATOR) + while (*path_list && *path_list != SEPCHAR) ++path_list; p = (struct search_path *) xmalloc (sizeof *p); @@ -3434,7 +3429,7 @@ add_search_path (char *path_list) else search_path = search_path_tail = p; - while (*path_list == PATH_LIST_SEPARATOR) + while (*path_list == SEPCHAR) ++path_list; } } diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 0ba6535b79d..20afe1cad11 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1,5 +1,6 @@ /* Client process that communicates with GNU Emacs acting as server. - Copyright (C) 1986-1987, 1994, 1999-2012 Free Software Foundation, Inc. + +Copyright (C) 1986-1987, 1994, 1999-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -112,13 +113,6 @@ char *(getcwd) (char *, size_t); /* Additional space when allocating buffers for filenames, etc. */ #define EXTRA_SPACE 100 -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ -#ifdef lint -# define IF_LINT(Code) Code -#else -# define IF_LINT(Code) /* empty */ -#endif - #ifdef min #undef min #endif @@ -213,21 +207,6 @@ xmalloc (size_t size) /* From sysdep.c */ #if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME) -/* From lisp.h */ -#ifndef DIRECTORY_SEP -#define DIRECTORY_SEP '/' -#endif -#ifndef IS_DIRECTORY_SEP -#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) -#endif -#ifndef IS_DEVICE_SEP -#ifndef DEVICE_SEP -#define IS_DEVICE_SEP(_c_) 0 -#else -#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP) -#endif -#endif - char *get_current_dir_name (void); /* Return the current working directory. Returns NULL on errors. diff --git a/lib-src/etags.c b/lib-src/etags.c index 69200b790fb..9c03735c954 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -4651,7 +4651,7 @@ Pascal_functions (FILE *inf) /* Check if this is an "extern" declaration. */ if (*dbp == '\0') continue; - if (lowcase (*dbp == 'e')) + if (lowcase (*dbp) == 'e') { if (nocase_tail ("extern")) /* superfluous, really! */ { diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index bd87b5b6524..2654387fb37 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -1,6 +1,7 @@ /* Generate doc-string file for GNU Emacs from source files. - Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2012 - Free Software Foundation, Inc. + +Copyright (C) 1985-1986, 1992-1994, 1997, 1999-2012 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -35,22 +36,26 @@ along with GNU Emacs. If not, see . */ #include -/* Defined to be emacs_main, sys_fopen, etc. in config.h. */ -#undef main -#undef fopen -#undef chdir - #include -#include +#include /* config.h unconditionally includes this anyway */ #ifdef MSDOS #include #endif /* MSDOS */ #ifdef WINDOWSNT +/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this + is really just insurance. */ +#undef fopen #include #include #endif /* WINDOWSNT */ #ifdef DOS_NT +/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this + is really just insurance. + + Similarly, msdos defines this as sys_chdir, but we're not linking with the + file where that function is defined. */ +#undef chdir #define READ_TEXT "rt" #define READ_BINARY "rb" #else /* not DOS_NT */ @@ -58,33 +63,12 @@ along with GNU Emacs. If not, see . */ #define READ_BINARY "r" #endif /* not DOS_NT */ -#ifndef DIRECTORY_SEP -#define DIRECTORY_SEP '/' -#endif - -#ifndef IS_DIRECTORY_SEP -#define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) -#endif - -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ -#ifdef lint -# define IF_LINT(Code) Code -#else -# define IF_LINT(Code) /* empty */ -#endif - static int scan_file (char *filename); static int scan_lisp_file (const char *filename, const char *mode); static int scan_c_file (char *filename, const char *mode); static void start_globals (void); static void write_globals (void); -#ifdef MSDOS -/* s/msdos.h defines this as sys_chdir, but we're not linking with the - file where that function is defined. */ -#undef chdir -#endif - #include /* Stdio stream for output to the DOC file. */ @@ -561,14 +545,15 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs) putc (')', out); } -/* The types of globals. */ +/* The types of globals. These are sorted roughly in decreasing alignment + order to avoid allocation gaps, except that functions are last. */ enum global_type { - FUNCTION, + INVALID, + LISP_OBJECT, EMACS_INTEGER, BOOLEAN, - LISP_OBJECT, - INVALID + FUNCTION, }; /* A single global. */ @@ -617,13 +602,8 @@ compare_globals (const void *a, const void *b) const struct global *ga = a; const struct global *gb = b; - if (ga->type == FUNCTION) - { - if (gb->type != FUNCTION) - return 1; - } - else if (gb->type == FUNCTION) - return -1; + if (ga->type != gb->type) + return ga->type - gb->type; return strcmp (ga->name, gb->name); } @@ -650,7 +630,7 @@ write_globals (void) type = "EMACS_INT"; break; case BOOLEAN: - type = "int"; + type = "bool"; break; case LISP_OBJECT: type = "Lisp_Object"; diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 8c9482b9194..a03d761e7ec 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -23,8 +23,7 @@ ALL = $(BLD)/test-distrib.exe $(BLD)/make-docfile.exe $(BLD)/hexl.exe\ .PHONY: make-docfile -LOCAL_FLAGS = -DWINDOWSNT -DDOS_NT -DNO_LDAV=1 \ - -DNO_ARCHIVES=1 -I../lib \ +LOCAL_FLAGS = -DNO_LDAV=1 -DNO_ARCHIVES=1 -I../lib \ -I../nt/inc -I../src $(EMACS_EXTRA_C_FLAGS) LIBS = $(BASE_LIBS) $(ADVAPI32) @@ -360,7 +359,7 @@ SRC = $(EMACS_ROOT)/src NT_INC = $(EMACS_ROOT)/nt/inc GNU_LIB = $(EMACS_ROOT)/lib -MS_W32_H = $(SRC)/s/ms-w32.h \ +MS_W32_H = $(NT_INC)/ms-w32.h \ $(NT_INC)/sys/stat.h CONF_POST_H = $(SRC)/conf_post.h \ $(MS_W32_H) diff --git a/lib-src/movemail.c b/lib-src/movemail.c index d157aa8c0b9..32d32e69abf 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -22,7 +22,7 @@ along with GNU Emacs. If not, see . */ /* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will cause loss of mail* if you do it on a system that does not normally - use flock as its way of interlocking access to inbox files. The + use flock/lockf as its way of interlocking access to inbox files. The setting of MAIL_USE_FLOCK and MAIL_USE_LOCKF *must agree* with the system's own conventions. It is not a choice that is up to you. @@ -109,6 +109,11 @@ along with GNU Emacs. If not, see . */ #include #endif +/* If your system uses the `flock' or `lockf' system call for mail locking, + define MAIL_USE_SYSTEM_LOCK. If your system type should always define + MAIL_USE_LOCKF or MAIL_USE_FLOCK but configure does not do this, + please make a bug report. */ + #ifdef MAIL_USE_LOCKF #define MAIL_USE_SYSTEM_LOCK #endif @@ -275,13 +280,6 @@ main (int argc, char **argv) else #endif { - #ifndef DIRECTORY_SEP - #define DIRECTORY_SEP '/' - #endif - #ifndef IS_DIRECTORY_SEP - #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP) - #endif - /* Use a lock file named after our first argument with .lock appended: If it exists, the mail file is locked. */ /* Note: this locking mechanism is *required* by the mailer @@ -290,20 +288,13 @@ main (int argc, char **argv) On systems that use a lock file, extracting the mail without locking WILL occasionally cause loss of mail due to timing errors! - So, if creation of the lock file fails - due to access permission on the mail spool directory, - you simply MUST change the permission - and/or make movemail a setgid program + So, if creation of the lock file fails due to access + permission on the mail spool directory, you simply MUST + change the permission and/or make movemail a setgid program so it can create lock files properly. - You might also wish to verify that your system is one - which uses lock files for this purpose. Some systems use other methods. - - If your system uses the `flock' system call for mail locking, - define MAIL_USE_SYSTEM_LOCK in config.h or the s-*.h file - and recompile movemail. If the s- file for your system - should define MAIL_USE_SYSTEM_LOCK but does not, send a bug report - to bug-gnu-emacs@prep.ai.mit.edu so we can fix it. */ + You might also wish to verify that your system is one which + uses lock files for this purpose. Some systems use other methods. */ inname_len = strlen (inname); lockname = xmalloc (inname_len + sizeof ".lock"); @@ -560,8 +551,8 @@ main (int argc, char **argv) wait (&wait_status); if (!WIFEXITED (wait_status)) exit (EXIT_FAILURE); - else if (WRETCODE (wait_status) != 0) - exit (WRETCODE (wait_status)); + else if (WEXITSTATUS (wait_status) != 0) + exit (WEXITSTATUS (wait_status)); #if !defined (MAIL_USE_MMDF) && !defined (MAIL_USE_SYSTEM_LOCK) #ifdef MAIL_USE_MAILLOCK diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index d3b001c157c..2cc791fb56a 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -1,5 +1,9 @@ /* Utility and Unix shadow routines for GNU Emacs support programs on NT. - Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc. + +Copyright (C) 1994, 2001-2012 Free Software Foundation, Inc. + +Author: Geoff Voelker (voelker@cs.washington.edu) +Created: 10-8-94 This file is part of GNU Emacs. @@ -14,11 +18,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . - - - Geoff Voelker (voelker@cs.washington.edu) 10-8-94 -*/ +along with GNU Emacs. If not, see . */ #include #include @@ -260,6 +260,7 @@ is_exec (const char * name) stricmp (p, ".cmd") == 0)); } +/* FIXME? This is in config.nt now - is this still needed? */ #define IS_DIRECTORY_SEP(x) ((x) == '/' || (x) == '\\') /* We need this because nt/inc/sys/stat.h defines struct stat that is @@ -374,3 +375,9 @@ stat (const char * path, struct stat * buf) return 0; } +int +lstat (const char * path, struct stat * buf) +{ + return stat (path, buf); +} + diff --git a/lib-src/profile.c b/lib-src/profile.c index d21f2c28e58..3489e492543 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c @@ -30,6 +30,8 @@ along with GNU Emacs. If not, see . */ */ #include +#define SYSTIME_INLINE EXTERN_INLINE + #include #include diff --git a/lib/Makefile.am b/lib/Makefile.am index 716510aff92..28fdafd4b45 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -5,6 +5,6 @@ MOSTLYCLEANFILES = noinst_LIBRARIES = AM_CFLAGS = $(GNULIB_WARN_CFLAGS) $(WERROR_CFLAGS) -DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src +DEFAULT_INCLUDES = -I. -I$(top_srcdir)/lib -I../src -I$(top_srcdir)/src include gnulib.mk diff --git a/lib/gnulib.mk b/lib/gnulib.mk index c85b923029e..0cc0e68bb7b 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -465,6 +465,7 @@ EXTRA_libgnu_a_SOURCES += stat.c ## begin gnulib module stat-time +libgnu_a_SOURCES += stat-time.c EXTRA_DIST += stat-time.h @@ -1092,6 +1093,7 @@ EXTRA_libgnu_a_SOURCES += time_r.c ## begin gnulib module timespec +libgnu_a_SOURCES += timespec.c EXTRA_DIST += timespec.h @@ -1111,6 +1113,7 @@ libgnu_a_SOURCES += timespec-sub.c ## begin gnulib module u64 +libgnu_a_SOURCES += u64.c EXTRA_DIST += u64.h diff --git a/lib/makefile.w32-in b/lib/makefile.w32-in index 4cebc727513..11251d55f77 100644 --- a/lib/makefile.w32-in +++ b/lib/makefile.w32-in @@ -1,5 +1,5 @@ # -*- Makefile -*- for GNU Emacs on the Microsoft Windows API. -# Copyright (C) 2011 Free Software Foundation, Inc. +# Copyright (C) 2011-2012 Free Software Foundation, Inc. # This file is part of GNU Emacs. @@ -39,6 +39,9 @@ GNULIBOBJS = $(BLD)/c-ctype.$(O) \ $(BLD)/sha1.$(O) \ $(BLD)/sha256.$(O) \ $(BLD)/sha512.$(O) \ + $(BLD)/stat-time.$(O) \ + $(BLD)/timespec.$(O) \ + $(BLD)/u64.$(O) \ $(BLD)/filemode.$(O) # @@ -71,7 +74,7 @@ NT_INC = $(EMACS_ROOT)/nt/inc C_CTYPE_H = $(GNU_LIB)/c-ctype.h \ $(NT_INC)/stdbool.h -MS_W32_H = $(SRC)/s/ms-w32.h \ +MS_W32_H = $(NT_INC)/ms-w32.h \ $(NT_INC)/sys/stat.h CONF_POST_H = $(SRC)/conf_post.h \ $(MS_W32_H) @@ -83,8 +86,7 @@ FTOASTR_H = $(GNU_LIB)/ftoastr.h \ $(GNU_LIB)/intprops.h FTOASTR_C = $(GNU_LIB)/ftoastr.c \ $(CONFIG_H) \ - $(FTOASTR_H) \ - $(GNU_LIB)/ftoastr.h + $(FTOASTR_H) GETOPT_INT_H = $(GNU_LIB)/getopt_int.h \ $(GNU_LIB)/getopt.h MD5_H = $(GNU_LIB)/md5.h \ @@ -96,8 +98,9 @@ SHA256_H = $(GNU_LIB)/sha256.h \ U64_H = $(GNU_LIB)/u64.h \ $(NT_INC)/stdint.h SHA512_H = $(GNU_LIB)/sha512.h \ - $(U64_H) \ - $(GNU_LIB)/u64.h + $(U64_H) +STAT_TIME_H = $(GNU_LIB)/stat-time.h \ + $(NT_INC)/sys/stat.h $(BLD)/c-ctype.$(O) : \ $(GNU_LIB)/c-ctype.c \ @@ -196,6 +199,21 @@ $(BLD)/sha512.$(O) : \ $(CONFIG_H) \ $(SHA512_H) +$(BLD)/stat-time.$(O) : \ + $(GNU_LIB)/stat-time.c \ + $(CONFIG_H) \ + $(STAT_TIME_H) + +$(BLD)/timespec.$(O) : \ + $(GNU_LIB)/timespec.c \ + $(GNU_LIB)/timespec.h \ + $(CONFIG_H) + +$(BLD)/u64.$(O) : \ + $(GNU_LIB)/u64.c \ + $(CONFIG_H) \ + $(U64_H) + $(BLD)/filemode.$(O) : \ $(GNU_LIB)/filemode.c \ $(CONFIG_H) \ diff --git a/lib/stat-time.c b/lib/stat-time.c new file mode 100644 index 00000000000..81b83ddb4fe --- /dev/null +++ b/lib/stat-time.c @@ -0,0 +1,3 @@ +#include +#define _GL_STAT_TIME_INLINE _GL_EXTERN_INLINE +#include "stat-time.h" diff --git a/lib/stat-time.h b/lib/stat-time.h index 30c2acdab63..74dd00aeb3e 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -23,6 +23,11 @@ #include #include +_GL_INLINE_HEADER_BEGIN +#ifndef _GL_STAT_TIME_INLINE +# define _GL_STAT_TIME_INLINE _GL_INLINE +#endif + /* STAT_TIMESPEC (ST, ST_XTIM) is the ST_XTIM member for *ST of type struct timespec, if available. If not, then STAT_TIMESPEC_NS (ST, ST_XTIM) is the nanosecond component of the ST_XTIM member for *ST, @@ -46,7 +51,7 @@ #endif /* Return the nanosecond component of *ST's access time. */ -static inline long int +_GL_STAT_TIME_INLINE long int get_stat_atime_ns (struct stat const *st) { # if defined STAT_TIMESPEC @@ -59,7 +64,7 @@ get_stat_atime_ns (struct stat const *st) } /* Return the nanosecond component of *ST's status change time. */ -static inline long int +_GL_STAT_TIME_INLINE long int get_stat_ctime_ns (struct stat const *st) { # if defined STAT_TIMESPEC @@ -72,7 +77,7 @@ get_stat_ctime_ns (struct stat const *st) } /* Return the nanosecond component of *ST's data modification time. */ -static inline long int +_GL_STAT_TIME_INLINE long int get_stat_mtime_ns (struct stat const *st) { # if defined STAT_TIMESPEC @@ -85,7 +90,7 @@ get_stat_mtime_ns (struct stat const *st) } /* Return the nanosecond component of *ST's birth time. */ -static inline long int +_GL_STAT_TIME_INLINE long int get_stat_birthtime_ns (struct stat const *st) { # if defined HAVE_STRUCT_STAT_ST_BIRTHTIMESPEC_TV_NSEC @@ -100,7 +105,7 @@ get_stat_birthtime_ns (struct stat const *st) } /* Return *ST's access time. */ -static inline struct timespec +_GL_STAT_TIME_INLINE struct timespec get_stat_atime (struct stat const *st) { #ifdef STAT_TIMESPEC @@ -114,7 +119,7 @@ get_stat_atime (struct stat const *st) } /* Return *ST's status change time. */ -static inline struct timespec +_GL_STAT_TIME_INLINE struct timespec get_stat_ctime (struct stat const *st) { #ifdef STAT_TIMESPEC @@ -128,7 +133,7 @@ get_stat_ctime (struct stat const *st) } /* Return *ST's data modification time. */ -static inline struct timespec +_GL_STAT_TIME_INLINE struct timespec get_stat_mtime (struct stat const *st) { #ifdef STAT_TIMESPEC @@ -143,7 +148,7 @@ get_stat_mtime (struct stat const *st) /* Return *ST's birth time, if available; otherwise return a value with tv_sec and tv_nsec both equal to -1. */ -static inline struct timespec +_GL_STAT_TIME_INLINE struct timespec get_stat_birthtime (struct stat const *st) { struct timespec t; @@ -186,4 +191,6 @@ get_stat_birthtime (struct stat const *st) return t; } +_GL_INLINE_HEADER_END + #endif diff --git a/lib/timespec.c b/lib/timespec.c new file mode 100644 index 00000000000..2b6098ed7bd --- /dev/null +++ b/lib/timespec.c @@ -0,0 +1,3 @@ +#include +#define _GL_TIMESPEC_INLINE _GL_EXTERN_INLINE +#include "timespec.h" diff --git a/lib/timespec.h b/lib/timespec.h index a58707947ce..d0a2194f61d 100644 --- a/lib/timespec.h +++ b/lib/timespec.h @@ -21,6 +21,11 @@ # include +_GL_INLINE_HEADER_BEGIN +#ifndef _GL_TIMESPEC_INLINE +# define _GL_TIMESPEC_INLINE _GL_INLINE +#endif + /* Return negative, zero, positive if A < B, A == B, A > B, respectively. For each time stamp T, this code assumes that either: @@ -49,7 +54,7 @@ The (int) cast avoids a gcc -Wconversion warning. */ -static inline int +_GL_TIMESPEC_INLINE int timespec_cmp (struct timespec a, struct timespec b) { return (a.tv_sec < b.tv_sec ? -1 @@ -59,7 +64,7 @@ timespec_cmp (struct timespec a, struct timespec b) /* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be nonnegative. */ -static inline int +_GL_TIMESPEC_INLINE int timespec_sign (struct timespec a) { return a.tv_sec < 0 ? -1 : a.tv_sec || a.tv_nsec; @@ -73,7 +78,7 @@ struct timespec dtotimespec (double) _GL_ATTRIBUTE_CONST; /* Return an approximation to A, of type 'double'. */ -static inline double +_GL_TIMESPEC_INLINE double timespectod (struct timespec a) { return a.tv_sec + a.tv_nsec / 1e9; @@ -82,4 +87,6 @@ timespectod (struct timespec a) void gettime (struct timespec *); int settime (struct timespec const *); +_GL_INLINE_HEADER_END + #endif diff --git a/lib/u64.c b/lib/u64.c new file mode 100644 index 00000000000..04cf7a29946 --- /dev/null +++ b/lib/u64.c @@ -0,0 +1,3 @@ +#include +#define _GL_U64_INLINE _GL_EXTERN_INLINE +#include "u64.h" diff --git a/lib/u64.h b/lib/u64.h index f5ec9ebcb3d..6a7d370c12b 100644 --- a/lib/u64.h +++ b/lib/u64.h @@ -19,6 +19,11 @@ #include +_GL_INLINE_HEADER_BEGIN +#ifndef _GL_U64_INLINE +# define _GL_U64_INLINE _GL_INLINE +#endif + /* Return X rotated left by N bits, where 0 < N < 64. */ #define u64rol(x, n) u64or (u64shl (x, n), u64shr (x, 64 - n)) @@ -54,7 +59,7 @@ typedef struct { uint32_t lo, hi; } u64; /* Given the high and low-order 32-bit quantities HI and LO, return a u64 value representing (HI << 32) + LO. */ -static inline u64 +_GL_U64_INLINE u64 u64hilo (uint32_t hi, uint32_t lo) { u64 r; @@ -64,7 +69,7 @@ u64hilo (uint32_t hi, uint32_t lo) } /* Return a u64 value representing LO. */ -static inline u64 +_GL_U64_INLINE u64 u64lo (uint32_t lo) { u64 r; @@ -74,7 +79,7 @@ u64lo (uint32_t lo) } /* Return a u64 value representing SIZE. */ -static inline u64 +_GL_U64_INLINE u64 u64size (size_t size) { u64 r; @@ -84,14 +89,14 @@ u64size (size_t size) } /* Return X < Y. */ -static inline int +_GL_U64_INLINE int u64lt (u64 x, u64 y) { return x.hi < y.hi || (x.hi == y.hi && x.lo < y.lo); } /* Return X & Y. */ -static inline u64 +_GL_U64_INLINE u64 u64and (u64 x, u64 y) { u64 r; @@ -101,7 +106,7 @@ u64and (u64 x, u64 y) } /* Return X | Y. */ -static inline u64 +_GL_U64_INLINE u64 u64or (u64 x, u64 y) { u64 r; @@ -111,7 +116,7 @@ u64or (u64 x, u64 y) } /* Return X ^ Y. */ -static inline u64 +_GL_U64_INLINE u64 u64xor (u64 x, u64 y) { u64 r; @@ -121,7 +126,7 @@ u64xor (u64 x, u64 y) } /* Return X + Y. */ -static inline u64 +_GL_U64_INLINE u64 u64plus (u64 x, u64 y) { u64 r; @@ -131,7 +136,7 @@ u64plus (u64 x, u64 y) } /* Return X << N. */ -static inline u64 +_GL_U64_INLINE u64 u64shl (u64 x, int n) { u64 r; @@ -149,7 +154,7 @@ u64shl (u64 x, int n) } /* Return X >> N. */ -static inline u64 +_GL_U64_INLINE u64 u64shr (u64 x, int n) { u64 r; @@ -167,3 +172,5 @@ u64shr (u64 x, int n) } #endif + +_GL_INLINE_HEADER_END diff --git a/lib/utimens.c b/lib/utimens.c index c126b9551a6..f06918cc23e 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -21,6 +21,7 @@ #include +#define _GL_UTIMENS_INLINE _GL_EXTERN_INLINE #include "utimens.h" #include diff --git a/lib/utimens.h b/lib/utimens.h index 8c47cf93f88..f765d102b77 100644 --- a/lib/utimens.h +++ b/lib/utimens.h @@ -1,3 +1,22 @@ +/* Set file access and modification times. + + Copyright 2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 3 of the License, or any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* Written by Paul Eggert. */ + #include int fdutimens (int, char const *, struct timespec const [2]); int utimens (char const *, struct timespec const [2]); @@ -7,13 +26,21 @@ int lutimens (char const *, struct timespec const [2]); # include # include +_GL_INLINE_HEADER_BEGIN +#ifndef _GL_UTIMENS_INLINE +# define _GL_UTIMENS_INLINE _GL_INLINE +#endif + int fdutimensat (int fd, int dir, char const *name, struct timespec const [2], int atflag); /* Using this function makes application code slightly more readable. */ -static inline int +_GL_UTIMENS_INLINE int lutimensat (int dir, char const *file, struct timespec const times[2]) { return utimensat (dir, file, times, AT_SYMLINK_NOFOLLOW); } + +_GL_INLINE_HEADER_END + #endif diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bc0496e0ca6..cc42b1493ee 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,631 @@ +2012-08-15 Stefan Monnier + + * vc/vc-mtn.el (vc-mtn-revision-completion-table): Handle completion + for composite selectors. + * vc/vc.el (vc-diff-build-argument-list-internal): Don't prevent + operation just because we can't find a previous revision. + +2012-08-15 Chong Yidong + + * frame.el (set-frame-font): Accept font objects. + +2012-08-15 Stefan Monnier + + * textmodes/tex-mode.el (tex-insert-quote): ~ is a space (bug#12137). + +2012-08-15 Wolfgang Jenkner + + * man.el (Man-overstrike-face, Man-underline-face) + (Man-reverse-face): Remove variables. + (Man-overstrike, Man-underline, Man-reverse): New faces. + (Man-fontify-manpage): Use them instead of the variables. + (Man-cleanup-manpage): Comment change. + (Man-ansi-color-map): New variable. + (Man-fontify-manpage): Use it. + Call ansi-color-apply-on-region to replace ad hoc code (bug#12147). + + Implement ANSI SGR parameters 22-27 (bug#12146). + * ansi-color.el (ansi-colors): Doc fix. + (ansi-color-context, ansi-color-context-region): Doc fix. + (ansi-color--find-face): New function. + (ansi-color-apply, ansi-color-apply-on-region): Use it. + Rename the local variable `face' to `codes' since it is now a list of + ansi codes. Doc fix. + (ansi-color-get-face): Remove. + (ansi-color-parse-sequence): New function, derived from + ansi-color-get-face. + (ansi-color-apply-sequence): Use it. Rewrite, and support ansi + codes 22-27. + +2012-08-14 Stefan Monnier + + * subr.el (read-passwd): Allow use from a minibuffer. + +2012-08-14 Eli Zaretskii + + * tooltip.el (tooltip-identifier-from-point): Don't treat tokens + inside comments and strings as identifiers. + + * progmodes/gud.el (gud-tooltip-print-command): Quote the + expression to evaluate. This allows to evaluate expressions with + embedded whitespace. + (gud-tooltip-tips): Add a blank before the newline in the + message-box text, for the benefit of message-box emulation on + MS-Windows. + + * progmodes/gdb-mi.el (gdb-tooltip-print): Don't ignore error + messages from GDB, pop them up in a tooltip to give feedback to + user. + (gdb-tooltip-print-1): Quote the expression to evaluate. + This allows to evaluate expressions with embedded whitespace. + (gdb-inferior-io--init-proc): Don't send "-inferior-tty" command + if the TTY name is nil or empty (which happens when communicating + with the inferior via pipes, e.g. on MS-Windows). + (gdb-internals): If GDB sends a "&\n" empty debugging message, + don't send that to the GUD buffer. + +2012-08-14 Glenn Morris + + * emacs-lisp/bytecomp.el (byte-compile-setq-default): + Optimize away setq-default with no args, as for setq. (Bug#12195) + +2012-08-14 Chong Yidong + + * minibuffer.el (read-file-name): Doc fix (Bug#10881). + + * emacs-lisp/regexp-opt.el (regexp-opt-charset): Doc fix + (Bug#12085). + +2012-08-14 Glenn Morris + + * emacs-lisp/bytecomp.el (byte-recompile-file): Doc fix. + +2012-08-14 Michael Albinus + + * net/tramp-sh.el (tramp-open-shell): Cache the shell name. + (tramp-find-shell, tramp-open-connection-setup-interactive-shell): + Use cached shell name. + +2012-08-14 Fabián Ezequiel Gallina + + * progmodes/python.el (python-shell-send-string): + (python-shell-send-setup-code): Do not use `format' with `message'. + +2012-08-14 Dmitry Gutov + + * progmodes/ruby-mode.el: Improve percent literals (bug#6286). + (ruby-percent-literal-beg-re): New constant. + (ruby-syntax-general-delimiters-goto-beg): Rename to + `ruby-syntax-enclosing-percent-literal', improve literal type check. + (ruby-syntax-propertize-general-delimiters): Rename to + `ruby-syntax-propertize-percent-literal', it's a shorter and more + popular term. Adjust comments everywhere. + (ruby-syntax-propertize-percent-literal): Only propertize when not + inside a simple string or comment. When the literal is unclosed, + leave the text after it unpropertized. + (ruby-syntax-methods-before-regexp): New constant. + (ruby-syntax-propertize-function): Use it to recognize regexps. + Don't look at the text after regexp, just use the whitelist. + +2012-08-14 Andreas Schwab + + * emacs-lisp/bytecomp.el (byte-recompile-file): When LOAD is + non-nil always load the compiled file if it exists. (Bug#12197) + +2012-08-14 Chong Yidong + + * hi-lock.el (hi-lock-mode): Do not unilaterally enable font lock. + (hi-lock-set-pattern): When deciding whether to use font lock or + overlays, look at font-lock-mode instead of font-lock-fontified + (Bug#12168). + (hi-lock-mode, hi-lock-line-face-buffer, hi-lock-unface-buffer) + (hi-lock-face-buffer, hi-lock-face-phrase-buffer): Doc fix. + +2012-08-14 Daiki Ueno + + * subr.el (internal--after-with-selected-window): Fix typo + (Bug#12193). + +2012-08-14 Fabián Ezequiel Gallina + + Use `completion-table-dynamic' for completion functions. + * progmodes/python.el + (python-shell-completion--do-completion-at-point) + (python-shell-completion--get-completions): + Remove functions. + (python-shell-completion-complete-at-point): New function. + (python-completion-complete-at-point): Use it. + +2012-08-13 Jambunathan K + + * vc/vc-dir.el (vc-dir-hide-state): New command (bug#12159). + (vc-dir-hide-up-to-date): Route it to `vc-dir-hide-state'. + +2012-08-13 Stefan Monnier + + * subr.el (function-get): Refine `autoload' arg so it can also + autoload functions for gv.el (bug#12191). + * emacs-lisp/edebug.el (get-edebug-spec): Adjust so it only + autoloads macros. + + * color.el (color-xyz-to-lab, color-lab-to-xyz, color-cie-de2000): + Prefer pcase-let over destructuring-bind. + * vc/diff-mode.el (diff-remove-trailing-whitespace): Same. + Also, remove whitespace as we go, rather than after accumulating the + various places. + + * subr.el (internal--before-with-selected-window) + (internal--after-with-selected-window): Fix typo seleted->selected. + (with-selected-window): Adjust callers. + Reported by Dmitry Gutov . + +2012-08-13 Bastien Guerry + + * window.el (special-display-popup-frame): Small docstring + enhancement. (Bug#12172) + +2012-08-13 Andreas Schwab + + * tar-mode.el (tar-header-data-end): Only ignore size for files of + type 1-6. + (tar-header-block-summarize, tar-get-descriptor): Handle pax + extended headers. + + * files.el (hack-local-variables-filter): Remove useless eval. + +2012-08-13 Martin Rudalics + + * subr.el (with-selected-window): Fix last change. + +2012-08-12 Stefan Monnier + + * subr.el (internal--before-with-seleted-window) + (internal--after-with-seleted-window): New functions. + (with-selected-window): Use them, to replace dependency on + tty-top-frame. + +2012-08-12 Nobuyoshi Nakada + + * progmodes/ruby-mode.el (ruby-mode-map): Remove unnecessary + binding for `newline'. + (ruby-move-to-block): When moving backward, stop at block opening, + not indentation. + * progmodes/ruby-mode.el (ruby-brace-to-do-end) + (ruby-do-end-to-brace, ruby-toggle-block): New functions. + * progmodes/ruby-mode.el (ruby-mode-map): Add binding for + `ruby-toggle-block'. + +2012-08-12 Stefan Monnier + + * ibuffer.el (ibuffer-do-toggle-read-only): + * dired.el (dired-toggle-read-only): + * buff-menu.el (Buffer-menu-toggle-read-only): + * bindings.el (mode-line-toggle-read-only): + * bs.el (bs-toggle-readonly): Call toggle-read-only interactively. + +2012-08-12 Andreas Schwab + + * descr-text.el (describe-char): Put the overlays over the + "displayed as" character. + +2012-08-12 Jay Belanger + + * calc/calc-units.el (math-default-units-table): Give an + initial value. + (math-put-default-units): Add options to put composite units and + unit systems in the default units table. + (calc-convert-units): Send composite units to + `math-put-default-units' when appropriate. + +2012-08-11 Glenn Morris + + * emacs-lisp/copyright.el (copyright-update-directory): Logic fix. + + * tutorial.el (help-with-tutorial): + * emacs-lisp/copyright.el (copyright-update-directory): + * emacs-lisp/autoload.el (autoload-find-generated-file) + (autoload-find-file): Disable local eval: (for insurance). + + * files.el (hack-local-variables-filter): If an eval: form is not + known to be safe, and enable-local-variables is :safe, then ignore + the form totally, as is done for non-eval forms. (Bug#12155) + +2012-08-10 Stefan Monnier + + * emacs-lisp/rx.el (rx-constituents): Don't define as constant. + (rx-form): Simplify. + +2012-08-09 Dmitry Gutov + + * progmodes/ruby-mode.el (ruby-expr-beg, ruby-parse-partial): + ?, _, and : are symbol constituents, ! is not (but kinda should be). + (ruby-syntax-propertize-heredoc): Use ruby-singleton-class-p. + (ruby-syntax-propertize-function): Adjust for changes in + `ruby-syntax-propertize-heredoc'. + +2012-08-09 Nobuyoshi Nakada + + * progmodes/ruby-mode.el (ruby-mode-map): Remove deprecated + binding (use `M-;' instead). + (ruby-singleton-class-p): New function. + (ruby-expr-beg, ruby-in-here-doc-p) Use it. + +2012-08-10 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-loop): Improve debug spec. + +2012-08-10 Chong Yidong + + * progmodes/python.el (python-shell-get-process-name): Don't mess + with same-window-buffer-names. + + * eshell/eshell.el (eshell-add-to-window-buffer-names) + (eshell-remove-from-window-buffer-names): Make obsolete. + (eshell-buffer-name, eshell-unload-hook): Don't use them. + (eshell): Just use pop-to-buffer-same-window instead. + +2012-08-10 Chong Yidong + + * bindings.el: Bind M-= back to count-words-region. + + * simple.el (count-words-region): Accept a prefix arg for acting + on the entire buffer. + (count-words--buffer-message): New helper function. + +2012-08-10 Stefan Monnier + + * term/x-win.el (x-menu-bar-open): Always pass last-nonmenu-event. + * subr.el (eventp): `nil' is not an event, and eventp is not hot. + (event-start, event-end): Use posn-at-point to return a more + informative posn. + (posnp): New function. + * mouse.el (popup-menu-normalize-position): Use it. + +2012-08-10 Masatake YAMATO + + * mouse.el (popup-menu-normalize-position): New function. + (popup-menu): Use `popup-menu-normalize-position' to normalize + the form for POSITION argument. + + * term/x-win.el (x-menu-bar-open): + Use the value returend from (posn-at-point) as position + passed to `popup-menu'. + +2012-08-09 Jay Belanger + + * calc/calccomp.el (math-compose-expr): Add extra argument + indicating that parentheses should be put around products in + denominators. Give multiplication precedence over division during + composition. + +2012-08-09 Chong Yidong + + * man.el (Man-switches, Man-sed-command, Man-awk-command) + (Man-mode-hook, Man-cooked-hook, Man-untabify-command-args) + (Man-untabify-command, manual-program): Convert to defcustom + (Bug#10429). + + * vc/add-log.el (change-log-mode): Bind comment-start to nil. + + * descr-text.el (describe-char): Don't insert extra newlines + (Bug#10127). + + * vc/log-view.el (log-view-diff): Use use-region-p (Bug#10133). + (log-view-diff-changeset, log-view-minor-wrap): Likewise. + + * align.el (align-region): Delete temporary markers (Bug#10047). + Plus some code cleanups. + +2012-08-09 Fabián Ezequiel Gallina + + * progmodes/python.el (python-pdbtrack-tracked-buffer) + (python-pdbtrack-buffers-to-kill, python-shell-internal-buffer) + (python-shell-internal-last-output): Use make-local-variable + instead of make-variable-buffer-local. + +2012-08-09 Fabián Ezequiel Gallina + + * progmodes/python.el: Enhancements to forward-sexp. + (python-nav-forward-sexp): Rename from + python-nav-forward-sexp-function. + (python-nav--forward-sexp, python-nav--backward-sexp): + New functions. + +2012-08-09 Jay Belanger + + * calc/calc-menu.el (calc-modes-menu): Add entries for matrix + modes and simplification modes. + +2012-08-09 Stefan Monnier + + * delsel.el (delete-selection-pre-hook): Don't propagate the + file-supersession signals (bug#12161). + +2012-08-08 Stefan Monnier + + * emacs-lisp/cl.el (cl-map-keymap-recursively, cl-map-intervals) + (cl-map-extents): Add compatibility aliases (bug#12135). + +2012-08-08 Michael Albinus + + * net/tramp-sh.el (tramp-find-file-exists-command): Protect the + tests by `ignore-error'. + (tramp-find-shell): Open also a new shell, when cache is already + set. Reported by Carsten Bormann . (Bug#12148) + +2012-08-08 Juri Linkov + + * bookmark.el: Add `defaults' property to the bookmark record. + (bookmark-current-buffer): Doc fix. + (bookmark-make-record): Add `defaults' property with default values + to the bookmark record. + (bookmark-minibuffer-read-name-map): Remove key binding "\C-u" + with `bookmark-insert-current-bookmark'. + (bookmark-set): Get `defaults' property from the bookmark record + and use it in `read-from-minibuffer'. + (bookmark-insert-current-bookmark): Remove function. + + * info.el (Info-bookmark-make-record): Add `defaults' property + with values of canonical Info node name, the current Info file + name and the current Info node name. (Bug#12107) + +2012-08-08 Juri Linkov + + * files.el (basic-save-buffer): Use `buffer-name' as the default + of `read-file-name' when buffer is not visiting a file (bug#12128). + +2012-08-08 Juri Linkov + + * info.el (Info-isearch-search): Doc fix. + (Info-search): Change search-failed message from "initial node" to + "end of node" (bug#12078). + (Info-isearch-search): Change `isearch-string-state' to + `isearch--state-string'. + +2012-08-08 Glenn Morris + + * language/persian.el: Remove file. + * language/misc-lang.el: Move unique part of persian.el here. + * loadup.el: Remove language/persian. + +2012-08-08 Óscar Fuentes + + * vc/diff-mode.el (diff-remove-trailing-whitespace): New function. + +2012-08-08 Fabián Ezequiel Gallina + + * progmodes/python.el Fixed defsubst warning. + (python-syntax-context) Rename from python-info-ppss-context. + (python-syntax-context-type): Rename from + python-info-ppss-context-type. + (python-syntax-comment-or-string-p): Rename from + python-info-ppss-comment-or-string-p. + +2012-08-08 Jay Belanger + + * calc/calc-misc.el (calc-record-why): Don't record a message twice. + +2012-08-07 Andreas Schwab + + * emacs-lisp/lisp-mode.el (eval-defun-1): Handle standard value of + a defcustom that is quoted with backquote. + + * calc/calc-prog.el (math-do-defmath): Use backquote forms. + Fix handling of interactive spec when the body uses return. + (math-do-arg-check, math-define-function-body): Use backquote forms. + * calc/calc-ext.el (math-defcache): Likewise. + * calc/calc-rewr.el (math-rwfail, math-rweval): Likewise. + * allout.el (allout-new-exposure): Likewise. + * calc/calcalg2.el (math-tracing-integral): Likewise. + * info.el (Info-last-menu-item): Likewise. + * emulation/vip.el (vip-loop): Likewise. + * textmodes/artist.el (artist-funcall): Likewise. + * menu-bar.el (menu-bar-make-mm-toggle, menu-bar-make-toggle): + Construct menu-item directly. + + * progmodes/autoconf.el (font-lock-syntactic-keywords): + Don't declare. + +2012-08-07 Chong Yidong + + * simple.el (deactivate-mark): Preserve text properties when + saving the primary selection (Bug#8384). + +2012-08-07 Kevin Ryde + + * woman.el (woman0-if): Quietly treat ".if v" as false (Bug#12109). + (woman-parse-numeric-value): On a bad .IP line, issue a warning + and continue processing (Bug#12110). + +2012-08-06 Stefan Monnier + + * progmodes/cperl-mode.el (cperl-mode): Yet another fix for + syntax-propertize-function (bug#10095). + +2012-08-06 Stefan Monnier + + * help-fns.el (help-fns--key-bindings, help-fns--signature) + (help-fns--parent-mode, help-fns--obsolete): New funs, extracted from + describe-function-1. + (describe-function-1): Use them. Move compiler macro after sig. + (help-fns--compiler-macro): Use function-get. Assume we're already in + standard-output. Adjust layout to new call order. + + * emacs-lisp/cl-macs.el (cl--sm-macroexpand): Fix handling of + re-binding a symbol that has a symbol-macro (bug#12119). + +2012-08-06 Mohsen BANAN + + * language/persian.el: New file. (Bug#11812) + * loadup.el: Add language/persian.el. + +2012-08-06 Chong Yidong + + * window.el (window--maybe-raise-frame): New function. + (window--display-buffer): Split off from here. + (display-buffer-reuse-window, display-buffer-pop-up-frame) + (display-buffer-pop-up-window, display-buffer-use-some-window): + Obey an inhibit-switch-frame action alist entry. + (display-buffer): Update doc. + + * replace.el (occur-after-change-function): Avoid losing focus by + using the inhibit-switch-frame display parameter (Bug#12139). + +2012-08-06 Fabián Ezequiel Gallina + + Make internal shell process buffer names start with space. + * progmodes/python.el (python-shell-make-comint): Add optional + argument INTERNAL. + (run-python-internal): Use it. + (python-shell-internal-get-or-create-process): Check for new + internal buffer names. + +2012-08-06 Glenn Morris + + * eshell/esh-ext.el (eshell/addpath): Use dolist and mapconcat. + Do less getting and setting of environment variables. + +2012-08-05 Chong Yidong + + * proced.el (proced): Add substitution string to docstring to + trigger autoloading of the proced library on C-h f (Bug#1768). + + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Don't show defvars which have no second argument (Bug#8638). + + * imenu.el (imenu-generic-expression): Move documentation here + from imenu--generic-function. + (imenu--generic-function): Refer to imenu-generic-expression. + +2012-08-05 Vegard Øye (tiny change) + + * emulation/viper-init.el (viper-deflocalvar): Add docstring and + indentation declaration. + (viper-loop): Add indentation declaration (Bug#7025). + +2012-08-05 Chong Yidong + + * help-fns.el (describe-variable): Add hyperlink for + directory-local variables files. Improve buffer-local and + permanent-local reporting; suggested by MON KEY (Bug#6644). + + * help-mode.el (help-dir-local-var-def): New button type. + + * files.el (kill-buffer-hook): Provide a defvar. + +2012-08-05 Glenn Morris + + * eshell/esh-ext.el (eshell/addpath): + Also update eshell-path-env. (Bug#12013) + +2012-08-05 Chong Yidong + + * wdired.el (wdired-mode, wdired-change-to-wdired-mode): Doc fixes. + + * fringe.el (fringe-styles): Add docstring. + (fringe--check-mode): New function. + (set-fringe-mode, set-fringe-style): Use it. + (fringe-mode, set-fringe-style): Doc fixes (Bug#6480). + + * files.el (set-auto-mode): Fix invalid setq call. + +2012-08-04 Stefan Monnier + + * isearch.el: Misc simplification; use defstruct. + (isearch-mode-map): Dense maps now work like sparse ones. + (isearch--state): New defstruct. + (isearch-string-state, isearch-message-state, isearch-point-state) + (isearch-success-state, isearch-forward-state) + (isearch-other-end-state, isearch-word-state, isearch-error-state) + (isearch-wrapped-state, isearch-barrier-state) + (isearch-case-fold-search-state, isearch-pop-fun-state): Remove, + replaced by defstruct's accessors. + (isearch--set-state): Rename from isearch-top-state and change + calling convention. + (isearch-push-state): Use new isearch--get-state. + (isearch-toggle-word): Disable regexp when enabling word. + (isearch-message-prefix): Remove unused arg _c-q-hack. + (isearch-message-suffix): Remove unused arg _ellipsis. + +2012-08-04 Andreas Schwab + + * simple.el (list-processes--refresh): For a server use :host or + :local as the address. + (list-processes): Doc fix. + +2012-08-04 Michal Nazarewicz (tiny change) + + * lisp/mpc.el: Support password in host argument. + (mpc--proc-connect): Parse and use new password element. + Set mpc-proc variable instead of returning process. + (mpc-proc): Adjust accordingly. + +2012-08-03 Eli Zaretskii + + * whitespace.el (whitespace-display-mappings): Use Unicode + codepoints, instead of emacs-mule codepoints. See + http://lists.gnu.org/archive/html/help-gnu-emacs/2012-07/msg00366.html + for the details. + + * files.el (file-truename): Don't skip symlink-chasing part on + windows-nt. Incorporate the resolution of 8+3 short aliases on + Windows into the loop that recursively chases symlinks. + Compare directory and its parent case-insensitively on MS-Windows and + MS-DOS. + +2012-08-03 Chong Yidong + + * menu-bar.el (menu-bar-tools-menu): Remove PCL-CVS. + + * sort.el (sort-regexp-fields): Doc fix. + +2012-08-03 Tassilo Horn + + * textmodes/reftex.el (reftex-compile-variables): Make keyvals + labels regex position point at the expected place. + +2012-08-03 MON KEY + + * net/imap.el (imap-interactive-login, imap-authenticate) + (imap-mailbox-lsub, imap-mailbox-list) + (imap-mailbox-status-asynch, imap-mailbox-acl-delete) + (imap-fetch, imap-message-flag-permanent-p, imap-envelope-from) + (imap-parse-response): Doc fix. + +2012-08-03 João Távora + + * textmodes/tex-mode.el (latex-forward-sexp): Terminate the loop + if sexp scanning does not move point (Bug#5734). + +2012-08-02 Tassilo Horn + + * textmodes/reftex-vars.el (reftex-default-label-alist-entries): + Add listings, minted, and ctable packages. + (reftex-label-alist-builtin): Move listings, minted, and ctable + entries before LaTeX. + (reftex-label-alist): Docfix. + +2012-08-02 Bastien Guerry + + * replace.el (occur): Fix docstring (bug#12122). + +2012-08-02 Glenn Morris + + * emacs-lisp/authors.el (authors-renamed-files-alist): Add ms-w32.h. + +2012-08-02 Paul Eggert + + Obsolete alias inactivate-current-input-method-function (Bug#10150). + * international/mule-cmds.el: Create + inactivate-current-input-method-function as an obsolete alias for + deactivate-current-input-method-function. See Katsumi Yamaoka in + . + +2012-08-01 Jay Belanger + + * calc/calc-mode.el (calc-set-simplify-mode): Use `cond' instead + of nested `if's. + 2012-08-01 Glenn Morris * progmodes/autoconf.el (autoconf-definition-regexp): @@ -154,9 +782,8 @@ * register.el (copy-to-register, copy-rectangle-to-register): Deactivate the mark, and use indicate-copied-region (Bug#10056). - (append-to-register, prepend-to-register): Call - -2012-07-29 Juri Linkov + (append-to-register, prepend-to-register): + Call 2012-07-29 Juri Linkov * simple.el (async-shell-command-buffer): New defcustom. (shell-command): Use it. (Bug#4719) @@ -173,7 +800,7 @@ * progmodes/gdb-mi.el (gdb-place-breakpoints): Fix the call to gdb-get-location. -2012-07-25 Leo Liu +2012-07-28 Leo Liu * progmodes/cc-menus.el (cc-imenu-objc-function): Avoid leaving nil in the alist (bug#12029). @@ -220,7 +847,7 @@ 2012-07-27 Fabián Ezequiel Gallina - * progmodes/python.el (python-mode-map): Added keybinding for + * progmodes/python.el (python-mode-map): Add keybinding for run-python. (python-shell-make-comint): Fix pop-to-buffer call. (run-python): Autoload. New arg SHOW. @@ -236,8 +863,8 @@ 2012-07-27 Tassilo Horn - * textmodes/reftex-vars.el (reftex-label-alist-builtin): Add - support for the lstlisting and minted environments, and for the + * textmodes/reftex-vars.el (reftex-label-alist-builtin): + Add support for the lstlisting and minted environments, and for the ctable macro. * textmodes/reftex.el (reftex-compile-variables): Also recognize labels written in keyvals syntax. @@ -252,8 +879,8 @@ * makefile.w32-in ($(lisp)/calendar/cal-loaddefs.el) ($(lisp)/calendar/diary-loaddefs.el) ($(lisp)/calendar/hol-loaddefs.el, $(lisp)/mh-e/mh-loaddefs.el) - ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs. Fixes - failures in parallel bootstrap because subdirs.el is being + ($(lisp)/net/tramp-loaddefs.el): Depend on update-subdirs. + Fixes failures in parallel bootstrap because subdirs.el is being rewritten while the autoload files are built at the same time, which needs to load subdirs.el. diff --git a/lisp/align.el b/lisp/align.el index 19fd85351f0..4c82d7bea81 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -1295,7 +1295,8 @@ aligner would have dealt with are." (report (and (not func) align-large-region beg end (>= (- end beg) align-large-region))) (rule-index 1) - (rule-count (length rules))) + (rule-count (length rules)) + markers) (if (and align-indent-before-aligning real-beg end-mark) (indent-region real-beg end-mark nil)) (while rules @@ -1315,14 +1316,14 @@ aligner would have dealt with are." (thissep (if rulesep (cdr rulesep) separate)) same (eol 0) search-start - group group-c + groups group-c spacing spacing-c tab-stop tab-stop-c repeat repeat-c valid valid-c first regions index - last-point b e + last-point save-match-data exclude-p align-props) @@ -1386,7 +1387,7 @@ aligner would have dealt with are." (when (or (not func) (funcall func beg end rule)) (unwind-protect - (let (exclude-areas) + (let (rule-beg exclude-areas) ;; determine first of all where the exclusions ;; lie in this region (when exclude-rules @@ -1451,11 +1452,10 @@ aligner would have dealt with are." ;; lookup the `group' attribute the first time ;; that we need it (unless group-c - (setq group (or (cdr (assq 'group rule)) 1)) - (if (listp group) - (setq first (car group)) - (setq first group group (list group))) - (setq group-c t)) + (setq groups (or (cdr (assq 'group rule)) 1)) + (unless (listp groups) + (setq groups (list groups))) + (setq first (car groups))) (unless spacing-c (setq spacing (cdr (assq 'spacing rule)) @@ -1464,19 +1464,19 @@ aligner would have dealt with are." (unless tab-stop-c (setq tab-stop (let ((rule-ts (assq 'tab-stop rule))) - (if rule-ts - (cdr rule-ts) - (if (symbolp align-to-tab-stop) - (symbol-value align-to-tab-stop) - align-to-tab-stop))) + (cond (rule-ts + (cdr rule-ts)) + ((symbolp align-to-tab-stop) + (symbol-value align-to-tab-stop)) + (t + align-to-tab-stop))) tab-stop-c t)) ;; test whether we have found a match on the same ;; line as a previous match - (if (> (point) eol) - (progn - (setq same nil) - (align--set-marker eol (line-end-position)))) + (when (> (point) eol) + (setq same nil) + (align--set-marker eol (line-end-position))) ;; lookup the `repeat' attribute the first time (or repeat-c @@ -1492,7 +1492,7 @@ aligner would have dealt with are." ;; match, and save the match-data, since either ;; the `valid' form, or the code that searches for ;; section separation, might alter it - (setq b (match-beginning first) + (setq rule-beg (match-beginning first) save-match-data (match-data)) ;; unless the `valid' attribute is set, and tells @@ -1504,15 +1504,13 @@ aligner would have dealt with are." ;; section. If so, we should align what we've ;; collected so far, and then begin collecting ;; anew for the next alignment section - (if (and last-point - (align-new-section-p last-point b - thissep)) - (progn - (align-regions regions align-props - rule func) - (setq regions nil) - (setq align-props nil))) - (align--set-marker last-point b t) + (when (and last-point + (align-new-section-p last-point rule-beg + thissep)) + (align-regions regions align-props rule func) + (setq regions nil) + (setq align-props nil)) + (align--set-marker last-point rule-beg t) ;; restore the match data (set-match-data save-match-data) @@ -1522,62 +1520,60 @@ aligner would have dealt with are." (let ((excls exclude-areas)) (setq exclude-p nil) (while excls - (if (and (< (match-beginning (car group)) + (if (and (< (match-beginning (car groups)) (cdar excls)) - (> (match-end (car (last group))) + (> (match-end (car (last groups))) (caar excls))) (setq exclude-p t excls nil) (setq excls (cdr excls))))) - ;; go through the list of parenthesis groups - ;; matching whitespace text to be - ;; contracted/expanded (or possibly - ;; justified, if the `justify' attribute was - ;; set) + ;; go through the parenthesis groups + ;; matching whitespace to be contracted or + ;; expanded (or possibly justified, if the + ;; `justify' attribute was set) (unless exclude-p - (let ((g group)) - (while g - - ;; we have to use markers, since - ;; `align-areas' may modify the buffer - (setq b (copy-marker - (match-beginning (car g)) t) - e (copy-marker (match-end (car g)) t)) - - ;; record this text region for alignment + (dolist (g groups) + ;; We must use markers, since + ;; `align-areas' may modify the buffer. + ;; Avoid polluting the markers. + (let* ((group-beg (copy-marker + (match-beginning g) t)) + (group-end (copy-marker + (match-end g) t)) + (region (cons group-beg group-end)) + (props (cons (if (listp spacing) + (car spacing) + spacing) + (if (listp tab-stop) + (car tab-stop) + tab-stop)))) + (push group-beg markers) + (push group-end markers) (setq index (if same (1+ index) 0)) - (let ((region (cons b e)) - (props (cons - (if (listp spacing) - (car spacing) - spacing) - (if (listp tab-stop) - (car tab-stop) - tab-stop)))) - (if (nth index regions) - (setcar (nthcdr index regions) - (cons region - (nth index regions))) - (if regions - (progn - (nconc regions - (list (list region))) - (nconc align-props (list props))) - (setq regions - (list (list region))) - (setq align-props (list props))))) - - ;; if any further rule matches are - ;; found before `eol', then they are - ;; on the same line as this one; this - ;; can only happen if the `repeat' - ;; attribute is non-nil - (if (listp spacing) - (setq spacing (cdr spacing))) - (if (listp tab-stop) - (setq tab-stop (cdr tab-stop))) - (setq same t g (cdr g)))) + (cond + ((nth index regions) + (setcar (nthcdr index regions) + (cons region + (nth index regions)))) + (regions + (nconc regions + (list (list region))) + (nconc align-props (list props))) + (t + (setq regions + (list (list region))) + (setq align-props (list props))))) + ;; If any further rule matches are found + ;; before `eol', they are on the same + ;; line as this one; this can only + ;; happen if the `repeat' attribute is + ;; non-nil. + (if (listp spacing) + (setq spacing (cdr spacing))) + (if (listp tab-stop) + (setq tab-stop (cdr tab-stop))) + (setq same t)) ;; if `repeat' has not been set, move to ;; the next line; don't bother searching @@ -1598,6 +1594,11 @@ aligner would have dealt with are." (setq case-fold-search current-case-fold))))))) (setq rules (cdr rules) rule-index (1+ rule-index))) + ;; This function can use a lot of temporary markers, so instead of + ;; waiting for the next GC we delete them immediately (Bug#10047). + (set-marker end-mark nil) + (dolist (m markers) + (set-marker m nil)) (if report (message "Aligning...done")))) diff --git a/lisp/allout.el b/lisp/allout.el index 7077af55e60..acf0b7d75b6 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1415,7 +1415,7 @@ their settings before allout-mode was started." ;;;_ = allout-exposure-change-functions (define-obsolete-variable-alias 'allout-exposure-change-hook - 'allout-exposure-change-functions "24.2") + 'allout-exposure-change-functions "24.3") (defcustom allout-exposure-change-functions nil "Abnormal hook run after allout outline subtree exposure changes. It is run at the conclusion of `allout-flag-region'. @@ -1429,11 +1429,11 @@ Functions on the hook must take three arguments: This hook might be invoked multiple times by a single command." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-structure-added-functions (define-obsolete-variable-alias 'allout-structure-added-hook - 'allout-structure-added-functions "24.2") + 'allout-structure-added-functions "24.3") (defcustom allout-structure-added-functions nil "Abnormal hook run after adding items to an Allout outline. Functions on the hook should take two arguments: @@ -1444,11 +1444,11 @@ Functions on the hook should take two arguments: This hook might be invoked multiple times by a single command." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-structure-deleted-functions (define-obsolete-variable-alias 'allout-structure-deleted-hook - 'allout-structure-deleted-functions "24.2") + 'allout-structure-deleted-functions "24.3") (defcustom allout-structure-deleted-functions nil "Abnormal hook run after deleting subtrees from an Allout outline. Functions on the hook must take two arguments: @@ -1462,11 +1462,11 @@ specifically edits that native allout routines do not control. This hook might be invoked multiple times by a single command." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-structure-shifted-functions (define-obsolete-variable-alias 'allout-structure-shifted-hook - 'allout-structure-shifted-functions "24.2") + 'allout-structure-shifted-functions "24.3") (defcustom allout-structure-shifted-functions nil "Abnormal hook run after shifting items in an Allout outline. Functions on the hook should take two arguments: @@ -1480,14 +1480,14 @@ that native allout routines do not control. This hook might be invoked multiple times by a single command." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-after-copy-or-kill-hook (defcustom allout-after-copy-or-kill-hook nil "Normal hook run after copying outline text.." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-post-undo-hook (defcustom allout-post-undo-hook nil @@ -1496,7 +1496,7 @@ The item that's current when the hook is run *may* be the one that was affected by the undo.." :type 'hook :group 'allout - :version "24.2") + :version "24.3") ;;;_ = allout-outside-normal-auto-fill-function (defvar allout-outside-normal-auto-fill-function nil @@ -5312,11 +5312,11 @@ Examples: Expose children and grandchildren of first topic at current level, and expose children of subsequent topics at current level *except* for the last, which should be opened completely." - (list 'save-excursion - '(if (not (or (allout-goto-prefix-doublechecked) - (allout-next-heading))) - (error "allout-new-exposure: Can't find any outline topics")) - (list 'allout-expose-topic (list 'quote spec)))) + `(save-excursion + (if (not (or (allout-goto-prefix-doublechecked) + (allout-next-heading))) + (error "allout-new-exposure: Can't find any outline topics")) + (allout-expose-topic ',spec))) ;;;_ #7 Systematic outline presentation -- copying, printing, flattening diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 18b2c846274..8305aaf1199 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -83,7 +83,7 @@ "Translating SGR control sequences to faces. This translation effectively colorizes strings and regions based upon SGR control sequences embedded in the text. SGR (Select Graphic -Rendition) control sequences are defined in section 3.8.117 of the +Rendition) control sequences are defined in section 8.3.117 of the ECMA-48 standard \(identical to ISO/IEC 6429), which is freely available as a PDF file ." :version "21.1" @@ -236,9 +236,10 @@ This is a good function to put in `comint-output-filter-functions'." ;; Working with strings (defvar ansi-color-context nil "Context saved between two calls to `ansi-color-apply'. -This is a list of the form (FACES FRAGMENT) or nil. FACES is a list of -faces the last call to `ansi-color-apply' ended with, and FRAGMENT is a -string starting with an escape sequence, possibly the start of a new +This is a list of the form (CODES FRAGMENT) or nil. CODES +represents the state the last call to `ansi-color-apply' ended +with, currently a list of ansi codes, and FRAGMENT is a string +starting with an escape sequence, possibly the start of a new escape sequence.") (make-variable-buffer-local 'ansi-color-context) @@ -270,6 +271,20 @@ This function can be added to `comint-preoutput-filter-functions'." (setq ansi-color-context (if fragment (list nil fragment)))) result)) +(defun ansi-color--find-face (codes) + "Return the face corresponding to CODES." + (let (faces) + (while codes + (let ((face (ansi-color-get-face-1 (pop codes)))) + ;; In the (default underline) face, say, the value of the + ;; "underline" attribute of the `default' face wins. + (unless (eq face 'default) + (push face faces)))) + ;; Avoid some long-lived conses in the common case. + (if (cdr faces) + (nreverse faces) + (car faces)))) + (defun ansi-color-apply (string) "Translates SGR control sequences into text properties. Delete all other control sequences without processing them. @@ -280,12 +295,12 @@ are given in `ansi-color-faces-vector' and `ansi-color-names-vector'. See function `ansi-color-apply-sequence' for details. Every call to this function will set and use the buffer-local variable -`ansi-color-context' to save partial escape sequences and current face. +`ansi-color-context' to save partial escape sequences and current ansi codes. This information will be used for the next call to `ansi-color-apply'. Set `ansi-color-context' to nil if you don't want this. This function can be added to `comint-preoutput-filter-functions'." - (let ((face (car ansi-color-context)) + (let ((codes (car ansi-color-context)) (start 0) end escape-sequence result colorized-substring) ;; If context was saved and is a string, prepend it. @@ -296,8 +311,8 @@ This function can be added to `comint-preoutput-filter-functions'." (while (setq end (string-match ansi-color-regexp string start)) (setq escape-sequence (match-string 1 string)) ;; Colorize the old block from start to end using old face. - (when face - (put-text-property start end 'font-lock-face face string)) + (when codes + (put-text-property start end 'font-lock-face (ansi-color--find-face codes) string)) (setq colorized-substring (substring string start end) start (match-end 0)) ;; Eliminate unrecognized ANSI sequences. @@ -306,10 +321,10 @@ This function can be added to `comint-preoutput-filter-functions'." (replace-match "" nil nil colorized-substring))) (push colorized-substring result) ;; Create new face, by applying escape sequence parameters. - (setq face (ansi-color-apply-sequence escape-sequence face))) + (setq codes (ansi-color-apply-sequence escape-sequence codes))) ;; if the rest of the string should have a face, put it there - (when face - (put-text-property start (length string) 'font-lock-face face string)) + (when codes + (put-text-property start (length string) 'font-lock-face (ansi-color--find-face codes) string)) ;; save context, add the remainder of the string to the result (let (fragment) (if (string-match "\033" string start) @@ -317,17 +332,18 @@ This function can be added to `comint-preoutput-filter-functions'." (setq fragment (substring string pos)) (push (substring string start pos) result)) (push (substring string start) result)) - (setq ansi-color-context (if (or face fragment) (list face fragment)))) + (setq ansi-color-context (if (or codes fragment) (list codes fragment)))) (apply 'concat (nreverse result)))) ;; Working with regions (defvar ansi-color-context-region nil "Context saved between two calls to `ansi-color-apply-on-region'. -This is a list of the form (FACES MARKER) or nil. FACES is a list of -faces the last call to `ansi-color-apply-on-region' ended with, and -MARKER is a buffer position within an escape sequence or the last -position processed.") +This is a list of the form (CODES MARKER) or nil. CODES +represents the state the last call to `ansi-color-apply-on-region' +ended with, currently a list of ansi codes, and MARKER is a +buffer position within an escape sequence or the last position +processed.") (make-variable-buffer-local 'ansi-color-context-region) (defun ansi-color-filter-region (begin end) @@ -365,13 +381,14 @@ between BEGIN and END, using overlays. The colors used are given in `ansi-color-faces-vector' and `ansi-color-names-vector'. See `ansi-color-apply-sequence' for details. -Every call to this function will set and use the buffer-local variable -`ansi-color-context-region' to save position and current face. This -information will be used for the next call to -`ansi-color-apply-on-region'. Specifically, it will override BEGIN, the -start of the region and set the face with which to start. Set -`ansi-color-context-region' to nil if you don't want this." - (let ((face (car ansi-color-context-region)) +Every call to this function will set and use the buffer-local +variable `ansi-color-context-region' to save position and current +ansi codes. This information will be used for the next call to +`ansi-color-apply-on-region'. Specifically, it will override +BEGIN, the start of the region and set the face with which to +start. Set `ansi-color-context-region' to nil if you don't want +this." + (let ((codes (car ansi-color-context-region)) (start-marker (or (cadr ansi-color-context-region) (copy-marker begin))) (end-marker (copy-marker end)) @@ -388,28 +405,27 @@ start of the region and set the face with which to start. Set ;; Colorize the old block from start to end using old face. (funcall ansi-color-apply-face-function start-marker (match-beginning 0) - face) + (ansi-color--find-face codes)) ;; store escape sequence and new start position (setq escape-sequence (match-string 1) start-marker (copy-marker (match-end 0))) ;; delete the escape sequence (replace-match "") - ;; create new face by applying all the parameters in the escape - ;; sequence - (setq face (ansi-color-apply-sequence escape-sequence face))) + ;; Update the list of ansi codes. + (setq codes (ansi-color-apply-sequence escape-sequence codes))) ;; search for the possible start of a new escape sequence (if (re-search-forward "\033" end-marker t) (progn ;; if the rest of the region should have a face, put it there (funcall ansi-color-apply-face-function - start-marker (point) face) - ;; save face and point + start-marker (point) (ansi-color--find-face codes)) + ;; save codes and point (setq ansi-color-context-region - (list face (copy-marker (match-beginning 0))))) + (list codes (copy-marker (match-beginning 0))))) ;; if the rest of the region should have a face, put it there (funcall ansi-color-apply-face-function - start-marker end-marker face) - (setq ansi-color-context-region (if face (list face))))))) + start-marker end-marker (ansi-color--find-face codes)) + (setq ansi-color-context-region (if codes (list codes))))))) (defun ansi-color-apply-overlay-face (beg end face) "Make an overlay from BEG to END, and apply face FACE. @@ -497,32 +513,56 @@ XEmacs uses `set-extent-face', Emacs uses `overlay-put'." ;; Helper functions -(defun ansi-color-apply-sequence (escape-sequence faces) - "Apply ESCAPE-SEQ to FACES and return the new list of faces. +(defsubst ansi-color-parse-sequence (escape-seq) + "Return the list of all the parameters in ESCAPE-SEQ. -ESCAPE-SEQ is an escape sequences parsed by `ansi-color-get-face'. +ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter +34 is used by `ansi-color-get-face-1' to return a face definition. -If the new faces start with the symbol `default', then the new -faces are returned. If the faces start with something else, -they are appended to the front of the FACES list, and the new -list of faces is returned. +Returns nil only if there's no match for `ansi-color-parameter-regexp'." + (let ((i 0) + codes val) + (while (string-match ansi-color-parameter-regexp escape-seq i) + (setq i (match-end 0) + val (string-to-number (match-string 1 escape-seq) 10)) + ;; It so happens that (string-to-number "") => 0. + (push val codes)) + (nreverse codes))) -If `ansi-color-get-face' returns nil, then we either got a -null-sequence, or we stumbled upon some garbage. In either -case we return nil." - (let ((new-faces (ansi-color-get-face escape-sequence))) - (cond ((null new-faces) - nil) - ((eq (car new-faces) 'default) - (cdr new-faces)) - (t - ;; Like (append NEW-FACES FACES) - ;; but delete duplicates in FACES. - (let ((modified-faces (copy-sequence faces))) - (dolist (face (nreverse new-faces)) - (setq modified-faces (delete face modified-faces)) - (push face modified-faces)) - modified-faces))))) +(defun ansi-color-apply-sequence (escape-sequence codes) + "Apply ESCAPE-SEQ to CODES and return the new list of codes. + +ESCAPE-SEQ is an escape sequence parsed by `ansi-color-parse-sequence'. + +If the new codes resulting from ESCAPE-SEQ start with 0, then the +old codes are discarded and the remaining new codes are +processed. Otherwise, for each new code: if it is 21-25 or 27-29 +delete appropriate parameters from the list of codes; any other +code that makes sense is added to the list of codes. Finally, +the so changed list of codes is returned." + (let ((new-codes (ansi-color-parse-sequence escape-sequence))) + (while new-codes + (setq codes + (let ((new (pop new-codes))) + (cond ((zerop new) + nil) + ((or (<= new 20) + (>= new 30)) + (if (memq new codes) + codes + (cons new codes))) + ;; The standard says `21 doubly underlined' while + ;; http://en.wikipedia.org/wiki/ANSI_escape_code claims + ;; `21 Bright/Bold: off or Underline: Double'. + ((/= new 26) + (remq (- new 20) + (cond ((= new 22) + (remq 1 codes)) + ((= new 25) + (remq 6 codes)) + (t codes)))) + (t codes))))) + codes)) (defun ansi-color-make-color-map () "Creates a vector of face definitions and returns it. @@ -588,28 +628,6 @@ ANSI-CODE is used as an index into the vector." (aref ansi-color-map ansi-code) (args-out-of-range nil))) -(defun ansi-color-get-face (escape-seq) - "Create a new face by applying all the parameters in ESCAPE-SEQ. - -Should any of the parameters result in the default face (usually this is -the parameter 0), then the effect of all previous parameters is canceled. - -ESCAPE-SEQ is a SGR control sequences such as \\033[34m. The parameter -34 is used by `ansi-color-get-face-1' to return a face definition." - (let ((i 0) - f val) - (while (string-match ansi-color-parameter-regexp escape-seq i) - (setq i (match-end 0) - val (ansi-color-get-face-1 - (string-to-number (match-string 1 escape-seq) 10))) - (cond ((not val)) - ((eq val 'default) - (setq f (list val))) - (t - (unless (member val f) - (push val f))))) - f)) - (provide 'ansi-color) ;;; ansi-color.el ends here diff --git a/lisp/apropos.el b/lisp/apropos.el index 6c6e3b325e8..88d5602a023 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -88,44 +88,44 @@ include key-binding information in its output." '((t (:inherit bold))) "Face for the symbol name in Apropos output." :group 'apropos - :version "24.2") + :version "24.3") (defface apropos-keybinding '((t (:inherit underline))) "Face for lists of keybinding in Apropos output." :group 'apropos - :version "24.2") + :version "24.3") (defface apropos-property '((t (:inherit font-lock-builtin-face))) "Face for property name in apropos output, or nil for none." :group 'apropos - :version "24.2") + :version "24.3") (defface apropos-function-button '((t (:inherit (font-lock-function-name-face button)))) "Button face indicating a function, macro, or command in Apropos." :group 'apropos - :version "24.2") + :version "24.3") (defface apropos-variable-button '((t (:inherit (font-lock-variable-name-face button)))) "Button face indicating a variable in Apropos." :group 'apropos - :version "24.2") + :version "24.3") (defface apropos-misc-button '((t (:inherit (font-lock-constant-face button)))) "Button face indicating a miscellaneous object type in Apropos." :group 'apropos - :version "24.2") + :version "24.3") (defcustom apropos-match-face 'match "Face for matching text in Apropos documentation/value, or nil for none. This applies when you look for matches in the documentation or variable value for the pattern; the part that matches gets displayed in this font." :group 'apropos - :version "24.2") + :version "24.3") (defcustom apropos-sort-by-scores nil "Non-nil means sort matches by scores; best match is shown first. diff --git a/lisp/bindings.el b/lisp/bindings.el index 655cda235b4..c20a7f30eea 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -40,8 +40,7 @@ corresponding to the mode line clicked." (interactive "e") (save-selected-window (select-window (posn-window (event-start event))) - (toggle-read-only nil t) - (force-mode-line-update))) + (call-interactively 'toggle-read-only))) (defun mode-line-toggle-modified (event) "Toggle the buffer-modified flag from the mode-line." @@ -144,7 +143,7 @@ message to display when the mouse is moved over the mode line. If the text at the mouse position has a `help-echo' text property, that overrides this variable." :type '(choice (const :tag "No help" :value nil) string) - :version "24.2" + :version "24.3" :group 'mode-line) (defvar mode-line-front-space '(:eval (if (display-graphic-p) " " "-")) @@ -793,7 +792,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key ctl-x-map "\C-o" 'delete-blank-lines) (define-key esc-map " " 'just-one-space) (define-key esc-map "z" 'zap-to-char) -(define-key esc-map "=" 'count-words) +(define-key esc-map "=" 'count-words-region) (define-key ctl-x-map "=" 'what-cursor-position) (define-key esc-map ":" 'eval-expression) ;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit. diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 8e6fb94c0dd..75a8d9f59dc 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -277,8 +277,8 @@ through a file easier.") (defvar bookmark-current-buffer nil "The buffer in which a bookmark is currently being set or renamed. Functions that insert strings into the minibuffer use this to know -the source buffer for that information; see `bookmark-yank-word' and -`bookmark-insert-current-bookmark' for example.") +the source buffer for that information; see `bookmark-yank-word' +for example.") (defvar bookmark-yank-point 0 @@ -473,6 +473,12 @@ equivalently just return ALIST without NAME.") (defun bookmark-make-record () "Return a new bookmark record (NAME . ALIST) for the current location." (let ((record (funcall bookmark-make-record-function))) + ;; Set up defaults. + (bookmark-prop-set + record 'defaults + (delq nil (delete-dups (append (bookmark-prop-get record 'defaults) + (list bookmark-current-bookmark + (bookmark-buffer-name)))))) ;; Set up default name. (if (stringp (car record)) ;; The function already provided a default name. @@ -738,10 +744,6 @@ This expects to be called from `point-min' in a bookmark file." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (define-key map "\C-w" 'bookmark-yank-word) - ;; This C-u binding might not be very useful any more now that we - ;; provide access to the default via the standard M-n binding. - ;; Maybe we should just remove it? --Stef-08 - (define-key map "\C-u" 'bookmark-insert-current-bookmark) map)) ;;;###autoload @@ -772,7 +774,19 @@ the list of bookmarks.)" (interactive (list nil current-prefix-arg)) (unwind-protect (let* ((record (bookmark-make-record)) - (default (car record))) + ;; `defaults' is a transient element of the + ;; extensible format described above in the section + ;; `File format stuff'. Bookmark record functions + ;; can use it to specify a list of default values + ;; accessible via M-n while reading a bookmark name. + (defaults (bookmark-prop-get record 'defaults)) + (default (if (consp defaults) (car defaults) defaults))) + + (if defaults + ;; Don't store default values in the record. + (setq record (assq-delete-all 'defaults record)) + ;; When no defaults in the record, use its first element. + (setq defaults (car record) default defaults)) (bookmark-maybe-load-default-file) ;; Don't set `bookmark-yank-point' and `bookmark-current-buffer' @@ -788,7 +802,7 @@ the list of bookmarks.)" (format "Set bookmark (%s): " default) nil bookmark-minibuffer-read-name-map - nil nil default)))) + nil nil defaults)))) (and (string-equal str "") (setq str default)) (bookmark-store str (cdr record) no-overwrite) @@ -888,18 +902,6 @@ Lines beginning with `#' are ignored." (bookmark-edit-annotation-mode bookmark-name-or-record)) -(defun bookmark-insert-current-bookmark () - "Insert into the bookmark name currently being set the value of -`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting -to the buffer's file name if `bookmark-current-bookmark' is nil." - (interactive) - (let ((str - (with-current-buffer bookmark-current-buffer - (or bookmark-current-bookmark - (bookmark-buffer-name))))) - (insert str))) - - (defun bookmark-buffer-name () "Return the name of the current buffer in a form usable as a bookmark name. If the buffer is associated with a file or directory, use that name." diff --git a/lisp/bs.el b/lisp/bs.el index 45a7e4d4440..09aefee416e 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -962,7 +962,7 @@ Default is `bs--current-sort-function'." Uses function `toggle-read-only'." (interactive) (with-current-buffer (bs--current-buffer) - (toggle-read-only)) + (call-interactively 'toggle-read-only)) (bs--update-current-line)) (defun bs-clear-modified () diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e9288d528ec..589b6ebc47a 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -57,23 +57,23 @@ the name column is assigned width `Buffer-menu-buffer+size-width' minus `Buffer-menu-size-width'. This use is deprecated." :type 'number :group 'Buffer-menu - :version "24.2") + :version "24.3") (make-obsolete-variable 'Buffer-menu-buffer+size-width "`Buffer-menu-name-width' and `Buffer-menu-size-width'" - "24.2") + "24.3") (defcustom Buffer-menu-name-width 19 "Width of buffer size column in the Buffer Menu." :type 'number :group 'Buffer-menu - :version "24.2") + :version "24.3") (defcustom Buffer-menu-size-width 7 "Width of buffer name column in the Buffer Menu." :type 'number :group 'Buffer-menu - :version "24.2") + :version "24.3") (defcustom Buffer-menu-mode-width 16 "Width of mode name column in the Buffer Menu." @@ -518,10 +518,10 @@ The current window remains selected." "Toggle read-only status of buffer on this line. This behaves like invoking \\[toggle-read-only] in that buffer." (interactive) - (let (read-only) - (with-current-buffer (Buffer-menu-buffer t) - (toggle-read-only) - (setq read-only buffer-read-only)) + (let ((read-only + (with-current-buffer (Buffer-menu-buffer t) + (call-interactively 'toggle-read-only) + buffer-read-only))) (tabulated-list-set-col 1 (if read-only "%" " ") t))) (defun Buffer-menu-bury () diff --git a/lisp/calc/README b/lisp/calc/README index f4f6b0fa0ba..25d1a5e9b58 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -70,7 +70,7 @@ opinions. Summary of changes to "Calc" ------- -- ------- -- ---- -Emacs 24.2 +Emacs 24.3 Algebraic simplification mode is now the default. To restrict to the limited simplifications given by the former diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 338330a793b..7089070df59 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1997,51 +1997,36 @@ calc-kill calc-kill-region calc-yank)))) (cache-val (intern (concat (symbol-name name) "-cache"))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) - (list 'progn -; (list 'defvar cache-prec (if init (math-numdigs (nth 1 init)) -100)) - (list 'defvar cache-prec - `(cond - ((consp ,init) (math-numdigs (nth 1 ,init))) - (,init - (nth 1 (math-numdigs (eval ,init)))) - (t - -100))) - (list 'defvar cache-val - `(cond - ((consp ,init) ,init) - (,init (eval ,init)) - (t ,init))) - (list 'defvar last-prec -100) - (list 'defvar last-val nil) - (list 'setq 'math-cache-list - (list 'cons - (list 'quote cache-prec) - (list 'cons - (list 'quote last-prec) - 'math-cache-list))) - (list 'defun - name () - (list 'or - (list '= last-prec 'calc-internal-prec) - (list 'setq - last-val - (list 'math-normalize - (list 'progn - (list 'or - (list '>= cache-prec - 'calc-internal-prec) - (list 'setq - cache-val - (list 'let - '((calc-internal-prec - (+ calc-internal-prec - 4))) - form) - cache-prec - '(+ calc-internal-prec 2))) - cache-val)) - last-prec 'calc-internal-prec)) - last-val)))) + `(progn +; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) + (defvar ,cache-prec (cond + ((consp ,init) (math-numdigs (nth 1 ,init))) + (,init + (nth 1 (math-numdigs (eval ,init)))) + (t + -100))) + (defvar ,cache-val (cond ((consp ,init) ,init) + (,init (eval ,init)) + (t ,init))) + (defvar ,last-prec -100) + (defvar ,last-val nil) + (setq math-cache-list + (cons ',cache-prec + (cons ',last-prec + math-cache-list))) + (defun ,name () + (or (= ,last-prec calc-internal-prec) + (setq ,last-val + (math-normalize + (progn (or (>= ,cache-prec calc-internal-prec) + (setq ,cache-val + (let ((calc-internal-prec + (+ calc-internal-prec 4))) + ,form) + ,cache-prec (+ calc-internal-prec 2))) + ,cache-val)) + ,last-prec calc-internal-prec)) + ,last-val)))) (put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index e67d169b683..9437c8bc105 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -1201,6 +1201,63 @@ :keys "v ." :style toggle :selected (not calc-full-vectors)] + (list "Simplification" + ["No simplification mode" + (progn + (require 'calc-mode) + (calc-no-simplify-mode t)) + :keys "m O" + :style radio + :selected (eq calc-simplify-mode 'none) + :help "No simplifications are done automatically"] + ["Numeric simplification mode" + (progn + (require 'calc-mode) + (calc-num-simplify-mode t)) + :keys "m N" + :style radio + :selected (eq calc-simplify-mode 'num) + :help "Only numeric simplifications are done automatically"] + ["Basic simplification mode" + (progn + (require 'calc-mode) + (calc-basic-simplify-mode t)) + :keys "m I" + :style radio + :selected (eq calc-simplify-mode nil) + :help "Only basic simplifications are done automatically"] + ["Binary simplification mode" + (progn + (require 'calc-mode) + (calc-bin-simplify-mode t)) + :keys "m B" + :style radio + :selected (eq calc-simplify-mode 'binary) + :help "Basic simplifications with binary clipping are done automatically"] + ["Algebraic simplification mode" + (progn + (require 'calc-mode) + (calc-alg-simplify-mode t)) + :keys "m A" + :style radio + :selected (eq calc-simplify-mode 'alg) + :help "Standard algebraic simplifications are done automatically"] + ["Extended simplification mode" + (progn + (require 'calc-mode) + (calc-ext-simplify-mode t)) + :keys "m E" + :style radio + :selected (eq calc-simplify-mode 'ext) + :help "Extended (unsafe) simplifications are done automatically"] + ["Units simplification mode" + (progn + (require 'calc-mode) + (calc-units-simplify-mode t)) + :keys "m U" + :style radio + :selected (eq calc-simplify-mode 'units) + :help "Algebraic and unit simplifications are done automatically"]) (list "Angle Measure" ["Radians" (progn @@ -1412,6 +1469,45 @@ :style radio :selected (eq calc-algebraic-mode 'total) :help "All regular letters and punctuation begin algebraic entry"]) + (list "Matrix" + ["Off" + (progn + (require 'calc-mode) + (calc-matrix-mode -1)) + :style radio + :selected (eq calc-matrix-mode nil) + :help "Variables are not assumed to be matrix or scalar"] + ["Matrix mode" + (progn + (require 'calc-mode) + (calc-matrix-mode -2)) + :style radio + :selected (eq calc-matrix-mode 'matrix) + :help "Variables are assumed to be matrices"] + ["Square matrix mode" + (progn + (require 'calc-mode) + (calc-matrix-mode '(4))) + :style radio + :selected (eq calc-matrix-mode 'sqmatrix) + :help "Variables are assumed to be square matrices"] + ["Dimensioned matrix mode" + (let ((dim (string-to-number (read-from-minibuffer "Dimension: ")))) + (if (natnump dim) + (progn + (require 'calc-mode) + (calc-matrix-mode dim)) + (error "The dimension must be a positive integer"))) + :style radio + :selected (and (integerp calc-matrix-mode) (> calc-matrix-mode 0)) + :help "Variables are assumed to be NxN matrices"] + ["Scalar mode" + (progn + (require 'calc-mode) + (calc-matrix-mode 0)) + :style radio + :selected (eq calc-matrix-mode 'scalar) + :help "Variables are assumed to be scalars"]) (list "Language" ["Normal" (progn diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index ac1b2621605..1d9c02a47a5 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -305,7 +305,8 @@ Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). (string-match "\\`\\*" (car stuff))) (setq stuff (cons '* (cons (substring (car stuff) 1) (cdr stuff))))))) - (setq calc-next-why (cons stuff calc-next-why)) + (unless (member stuff calc-next-why) + (setq calc-next-why (cons stuff calc-next-why))) nil) ;; True if A is a constant or vector of constants. [P x] [Public] diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 333485d8f94..f64e37dc0bf 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -497,11 +497,11 @@ (defun calc-set-simplify-mode (mode arg msg) (calc-change-mode 'calc-simplify-mode - (if arg - (and (> (prefix-numeric-value arg) 0) - mode) - (and (not (eq calc-simplify-mode mode)) - mode))) + (cond + (arg mode) + ((eq calc-simplify-mode mode) + 'alg) + (t mode))) (message "%s" (if (eq calc-simplify-mode mode) msg "Algebraic simplification occurs by default"))) diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index f702033c0fb..411f55a24e6 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -1792,89 +1792,63 @@ Redefine the corresponding command." (defun math-do-defmath (func args body) (require 'calc-macs) (let* ((fname (intern (concat "calcFunc-" (symbol-name func)))) - (doc (if (stringp (car body)) (list (car body)))) + (doc (if (stringp (car body)) + (prog1 (list (car body)) + (setq body (cdr body))))) (clargs (mapcar 'math-clean-arg args)) - (body (math-define-function-body - (if (stringp (car body)) (cdr body) body) - clargs))) - (list 'progn - (if (and (consp (car body)) - (eq (car (car body)) 'interactive)) - (let ((inter (car body))) - (setq body (cdr body)) - (if (or (> (length inter) 2) - (integerp (nth 1 inter))) - (let ((hasprefix nil) (hasmulti nil)) - (if (stringp (nth 1 inter)) - (progn - (cond ((equal (nth 1 inter) "p") - (setq hasprefix t)) - ((equal (nth 1 inter) "m") - (setq hasmulti t)) - (t (error - "Can't handle interactive code string \"%s\"" - (nth 1 inter)))) - (setq inter (cdr inter)))) - (if (not (integerp (nth 1 inter))) - (error - "Expected an integer in interactive specification")) - (append (list 'defun - (intern (concat "calc-" - (symbol-name func))) - (if (or hasprefix hasmulti) - '(&optional n) - ())) - doc - (if (or hasprefix hasmulti) - '((interactive "P")) - '((interactive))) - (list - (append - '(calc-slow-wrapper) - (and hasmulti - (list - (list 'setq - 'n - (list 'if - 'n - (list 'prefix-numeric-value - 'n) - (nth 1 inter))))) - (list - (list 'calc-enter-result - (if hasmulti 'n (nth 1 inter)) - (nth 2 inter) - (if hasprefix - (list 'append - (list 'quote (list fname)) - (list 'calc-top-list-n - (nth 1 inter)) - (list 'and - 'n - (list - 'list - (list - 'math-normalize - (list - 'prefix-numeric-value - 'n))))) - (list 'cons - (list 'quote fname) - (list 'calc-top-list-n - (if hasmulti - 'n - (nth 1 inter))))))))))) - (append (list 'defun - (intern (concat "calc-" (symbol-name func))) - args) - doc - (list - inter - (cons 'calc-wrapper body)))))) - (append (list 'defun fname clargs) - doc - (math-do-arg-list-check args nil nil) - body)))) + (inter (if (and (consp (car body)) + (eq (car (car body)) 'interactive)) + (prog1 (car body) + (setq body (cdr body)))))) + (setq body (math-define-function-body body clargs)) + `(progn + ,(if inter + (if (or (> (length inter) 2) + (integerp (nth 1 inter))) + (let ((hasprefix nil) (hasmulti nil)) + (when (stringp (nth 1 inter)) + (cond ((equal (nth 1 inter) "p") + (setq hasprefix t)) + ((equal (nth 1 inter) "m") + (setq hasmulti t)) + (t (error + "Can't handle interactive code string \"%s\"" + (nth 1 inter)))) + (setq inter (cdr inter))) + (unless (integerp (nth 1 inter)) + (error "Expected an integer in interactive specification")) + `(defun ,(intern (concat "calc-" (symbol-name func))) + ,(if (or hasprefix hasmulti) '(&optional n) ()) + ,@doc + (interactive ,@(if (or hasprefix hasmulti) '("P"))) + (calc-slow-wrapper + ,@(if hasmulti + `((setq n (if n + (prefix-numeric-value n) + ,(nth 1 inter))))) + (calc-enter-result + ,(if hasmulti 'n (nth 1 inter)) + ,(nth 2 inter) + ,(if hasprefix + `(append '(,fname) + (calc-top-list-n ,(nth 1 inter)) + (and n + (list + (math-normalize + (prefix-numeric-value n))))) + `(cons ',fname + (calc-top-list-n + ,(if hasmulti + 'n + (nth 1 inter))))))))) + `(defun ,(intern (concat "calc-" (symbol-name func))) ,clargs + ,@doc + ,inter + (calc-wrapper ,@body)))) + (defun ,fname ,clargs + ,@doc + ,@(math-do-arg-list-check args nil nil) + ,@body)))) (defun math-clean-arg (arg) (if (consp arg) @@ -1887,56 +1861,42 @@ Redefine the corresponding command." (list (cons 'and (cons var (if (cdr chk) - (setq chk (list (cons 'progn chk))) + `((progn ,@chk)) chk))))) - (and (consp arg) - (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest)) - (qual (car arg)) - (qqual (list 'quote qual)) - (qual-name (symbol-name qual)) - (chk (intern (concat "math-check-" qual-name)))) - (if (fboundp chk) - (append rest - (list + (when (consp arg) + (let* ((rest (math-do-arg-check (nth 1 arg) var is-opt is-rest)) + (qual (car arg)) + (qual-name (symbol-name qual)) + (chk (intern (concat "math-check-" qual-name)))) + (if (fboundp chk) + (append rest + (if is-rest + `((setq ,var (mapcar ',chk ,var))) + `((setq ,var (,chk ,var))))) + (if (fboundp (setq chk (intern (concat "math-" qual-name)))) + (append rest + (if is-rest + `((mapcar #'(lambda (x) + (or (,chk x) + (math-reject-arg x ',qual))) + ,var)) + `((or (,chk ,var) + (math-reject-arg ,var ',qual))))) + (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name) + (fboundp (setq chk (intern + (concat "math-" + (math-match-substring + qual-name 1)))))) + (append rest (if is-rest - (list 'setq var - (list 'mapcar (list 'quote chk) var)) - (list 'setq var (list chk var))))) - (if (fboundp (setq chk (intern (concat "math-" qual-name)))) - (append rest - (list - (if is-rest - (list 'mapcar - (list 'function - (list 'lambda '(x) - (list 'or - (list chk 'x) - (list 'math-reject-arg - 'x qqual)))) - var) - (list 'or - (list chk var) - (list 'math-reject-arg var qqual))))) - (if (and (string-match "\\`not-\\(.*\\)\\'" qual-name) - (fboundp (setq chk (intern - (concat "math-" - (math-match-substring - qual-name 1)))))) - (append rest - (list - (if is-rest - (list 'mapcar - (list 'function - (list 'lambda '(x) - (list 'and - (list chk 'x) - (list 'math-reject-arg - 'x qqual)))) - var) - (list 'and - (list chk var) - (list 'math-reject-arg var qqual))))) - (error "Unknown qualifier `%s'" qual-name)))))))) + `((mapcar #'(lambda (x) + (and (,chk x) + (math-reject-arg x ',qual))) + ,var)) + `((and + (,chk ,var) + (math-reject-arg ,var ',qual))))) + (error "Unknown qualifier `%s'" qual-name)))))))) (defun math-do-arg-list-check (args is-opt is-rest) (cond ((null args) nil) @@ -1980,7 +1940,7 @@ Redefine the corresponding command." (defun math-define-function-body (body env) (let ((body (math-define-body body env))) (if (math-body-refers-to body 'math-return) - (list (cons 'catch (cons '(quote math-return) body))) + `((catch 'math-return ,@body)) body))) ;; The variable math-exp-env is local to math-define-body, but is diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index 545b9338a0b..eed8a756e8e 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -1439,21 +1439,19 @@ (put 'calcFunc-vxor 'math-rewrite-default '(vec)) (defmacro math-rwfail (&optional back) - (list 'setq 'pc - (list 'and - (if back - '(setq btrack (cdr btrack)) - 'btrack) - ''((backtrack))))) + `(setq pc (and ,(if back + '(setq btrack (cdr btrack)) + 'btrack) + '((backtrack))))) ;; This monstrosity is necessary because the use of static vectors of ;; registers makes rewrite rules non-reentrant. Yucko! (defmacro math-rweval (form) - (list 'let '((orig (car rules))) - '(setcar rules (quote (nil nil nil no-phase))) - (list 'unwind-protect - form - '(setcar rules orig)))) + `(let ((orig (car rules))) + (setcar rules '(nil nil nil no-phase)) + (unwind-protect + ,form + (setcar rules orig)))) (defvar math-rewrite-phase 1) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index e5c7b6737fb..39f710f8322 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -404,7 +404,7 @@ If EXPR is nil, return nil." (math-composition-to-string cexpr)))))) (defvar math-default-units-table - (make-hash-table :test 'equal) + #s(hash-table test equal data (1 (1))) "A table storing previously converted units.") (defun math-get-default-units (expr) @@ -418,22 +418,24 @@ If EXPR is nil, return nil." (math-make-unit-string (cadr default-units)) (math-make-unit-string (car default-units))))) -(defun math-put-default-units (expr) - "Put the units in EXPR in the default units table." - (let ((units (math-get-units expr))) - (unless (eq units 1) - (let* ((standard-units (math-get-standard-units expr)) - (default-units (gethash - standard-units - math-default-units-table))) - (cond - ((not default-units) - (puthash standard-units (list units) math-default-units-table)) - ((not (equal units (car default-units))) - (puthash standard-units - (list units (car default-units)) - math-default-units-table))))))) - +(defun math-put-default-units (expr &optional comp std) + "Put the units in EXPR in the default units table. +If COMP or STD is non-nil, put that in the units table instead." + (let* ((new-units (or comp std (math-get-units expr))) + (standard-units (math-get-standard-units + (cond + (comp (math-simplify-units expr)) + (std expr) + (t new-units)))) + (default-units (gethash standard-units math-default-units-table))) + (unless (eq standard-units 1) + (cond + ((not default-units) + (puthash standard-units (list new-units) math-default-units-table)) + ((not (equal new-units (car default-units))) + (puthash standard-units + (list new-units (car default-units)) + math-default-units-table)))))) (defun calc-convert-units (&optional old-units new-units) (interactive) @@ -457,47 +459,48 @@ If EXPR is nil, return nil." (when (eq (car-safe uold) 'error) (error "Bad format in units expression: %s" (nth 1 uold))) (setq expr (math-mul expr uold)))) - (unless new-units - (setq defunits (math-get-default-units expr)) - (setq new-units - (read-string (concat - (if uoldname - (concat "Old units: " - uoldname - ", new units") - "New units") - (if defunits - (concat - " (default " - defunits - "): ") - ": ")))) - - (if (and - (string= new-units "") - defunits) - (setq new-units defunits))) - (when (string-match "\\` */" new-units) - (setq new-units (concat "1" new-units))) - (setq units (math-read-expr new-units)) - (when (eq (car-safe units) 'error) - (error "Bad format in units expression: %s" (nth 2 units))) - (if calc-ensure-consistent-units - (math-check-unit-consistency expr units)) - (math-put-default-units units) - (let ((unew (math-units-in-expr-p units t)) - (std (and (eq (car-safe units) 'var) - (assq (nth 1 units) math-standard-units-systems)))) - (if std - (calc-enter-result 1 "cvun" (math-simplify-units - (math-to-standard-units expr - (nth 1 std)))) - (unless unew + (setq defunits (math-get-default-units expr)) + (if (equal defunits "1") + (progn + (calc-enter-result 1 "cvun" (math-simplify-units expr)) + (message "All units in expression cancel")) + (unless new-units + (setq new-units + (read-string (concat + (if uoldname + (concat "Old units: " + uoldname + ", new units") + "New units") + (if defunits + (concat + " (default " + defunits + "): ") + ": ")))) + (if (and + (string= new-units "") + defunits) + (setq new-units defunits))) + (when (string-match "\\` */" new-units) + (setq new-units (concat "1" new-units))) + (setq units (math-read-expr new-units)) + (when (eq (car-safe units) 'error) + (error "Bad format in units expression: %s" (nth 2 units))) + (if calc-ensure-consistent-units + (math-check-unit-consistency expr units)) + (let ((unew (math-units-in-expr-p units t)) + (std (and (eq (car-safe units) 'var) + (assq (nth 1 units) math-standard-units-systems))) + (comp (eq (car-safe units) '+))) + (unless (or unew std) (error "No units specified")) - (calc-enter-result 1 "cvun" - (math-convert-units - expr units - (and uoldname (not (equal uoldname "1")))))))))) + (let ((res + (if std + (math-simplify-units (math-to-standard-units expr (nth 1 std))) + (math-convert-units expr units (and uoldname (not (equal uoldname "1"))))))) + (math-put-default-units res (if comp units)) + (calc-enter-result 1 "cvun" res))))))) (defun calc-autorange-units (arg) (interactive "P") diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index fdc70a69fbd..5fd5b35654c 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -667,21 +667,18 @@ (defvar math-integral-limit) (defmacro math-tracing-integral (&rest parts) - (list 'and - 'trace-buffer - (list 'with-current-buffer - 'trace-buffer - '(goto-char (point-max)) - (list 'and - '(bolp) - '(insert (make-string (- math-integral-limit - math-integ-level) 32) - (format "%2d " math-integ-depth) - (make-string math-integ-level 32))) - ;;(list 'condition-case 'err - (cons 'insert parts) - ;; '(error (insert (prin1-to-string err)))) - '(sit-for 0)))) + `(and trace-buffer + (with-current-buffer trace-buffer + (goto-char (point-max)) + (and (bolp) + (insert (make-string (- math-integral-limit + math-integ-level) 32) + (format "%2d " math-integ-depth) + (make-string math-integ-level 32))) + ;;(condition-case err + (insert ,@parts) + ;; (error (insert (prin1-to-string err)))) + (sit-for 0)))) ;;; The following wrapper caches results and avoids infinite recursion. ;;; Each cache entry is: ( A B ) Integral of A is B; diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index d8ad7e2cede..51ea8e7b7a3 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -86,8 +86,11 @@ (setq sn (math-to-underscores sn))) sn))) -(defun math-compose-expr (a prec) - (let ((math-compose-level (1+ math-compose-level)) +;;; Give multiplication precendence when composing to avoid +;;; writing a*(b c) instead of a b c +(defun math-compose-expr (a prec &optional div) + (let ((calc-multiplication-has-precedence t) + (math-compose-level (1+ math-compose-level)) (math-expr-opers (math-expr-ops)) spfn) (cond @@ -591,7 +594,9 @@ (or (= (length a) 3) (eq (car a) 'calcFunc-if)) (/= (nth 3 op) -1)) (cond - ((> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op)))) + ((or + (> prec (or (nth 4 op) (min (nth 2 op) (nth 3 op)))) + (and div (eq (car a) '*))) (if (and (memq calc-language '(tex latex)) (not (math-tex-expr-is-flat a))) (if (eq (car-safe a) '/) @@ -631,7 +636,7 @@ nil) math-compose-level)) (lhs (math-compose-expr (nth 1 a) (nth 2 op))) - (rhs (math-compose-expr (nth 2 a) (nth 3 op)))) + (rhs (math-compose-expr (nth 2 a) (nth 3 op) (eq (nth 1 op) '/)))) (and (equal (car op) "^") (eq (math-comp-first-char lhs) ?-) (setq lhs (list 'horiz "(" lhs ")"))) diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el index 9e9544d707b..dff370460af 100644 --- a/lisp/calendar/cal-html.el +++ b/lisp/calendar/cal-html.el @@ -68,7 +68,7 @@ (defcustom cal-html-holidays t "If non-nil, include holidays as well as diary entries." - :version "24.2" + :version "24.3" :type 'boolean :group 'calendar-html) @@ -92,7 +92,7 @@ "\n\n") "Default cal-html css style. You can override this with a \"cal.css\" file." :type 'string - :version "24.2" ; added SPAN.HOLIDAY + :version "24.3" ; added SPAN.HOLIDAY :group 'calendar-html) ;;; End customizable variables. diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 2452f44448c..a40c05f45ca 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -239,7 +239,7 @@ This definition is the heart of the calendar!") (autoload 'holiday-in-range "holidays") -(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.2") +(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3") (autoload 'diary-list-entries "diary-lib") diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 8ca14b37d70..2ebb8c7c3ae 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -268,7 +268,7 @@ The time is bracketed by <> if you are clocked in, otherwise by [].") ;;; User Functions: (define-obsolete-function-alias 'timeclock-modeline-display - 'timeclock-mode-line-display "24.2") + 'timeclock-mode-line-display "24.3") ;;;###autoload (defun timeclock-mode-line-display (&optional arg) @@ -649,7 +649,7 @@ arguments of `completing-read'." (mapcar 'list timeclock-reason-list))) (define-obsolete-function-alias 'timeclock-update-modeline - 'timeclock-update-mode-line "24.2") + 'timeclock-update-mode-line "24.3") (defun timeclock-update-mode-line () "Update the `timeclock-mode-string' displayed in the mode line. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index b946e756ff8..925bde8a193 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,7 @@ +2012-08-07 Andreas Schwab + + * ede/base.el (ede-with-projectfile): Use backquote forms. + 2012-07-29 Paul Eggert inaccessable -> inaccessible spelling fix (Bug#10052) diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 4365fdc2190..ce3d4a036f3 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -285,22 +285,18 @@ All specific project types must derive from this project." ;; (defmacro ede-with-projectfile (obj &rest forms) "For the project in which OBJ resides, execute FORMS." - (list 'save-window-excursion - (list 'let* (list - (list 'pf - (list 'if (list 'obj-of-class-p - obj 'ede-target) - ;; @todo -I think I can change - ;; this to not need ede-load-project-file - ;; but I'm not sure how to test well. - (list 'ede-load-project-file - (list 'oref obj 'path)) - obj)) - '(dbka (get-file-buffer (oref pf file)))) - '(if (not dbka) (find-file (oref pf file)) - (switch-to-buffer dbka)) - (cons 'progn forms) - '(if (not dbka) (kill-buffer (current-buffer)))))) + `(save-window-excursion + (let* ((pf (if (obj-of-class-p ,obj ede-target) + ;; @todo -I think I can change + ;; this to not need ede-load-project-file + ;; but I'm not sure how to test well. + (ede-load-project-file (oref ,obj path)) + ,obj)) + (dbka (get-file-buffer (oref pf file)))) + (if (not dbka) (find-file (oref pf file)) + (switch-to-buffer dbka)) + ,@forms + (if (not dbka) (kill-buffer (current-buffer)))))) (put 'ede-with-projectfile 'lisp-indent-function 1) ;;; The EDE persistent cache. diff --git a/lisp/color.el b/lisp/color.el index 6ccf9a79494..94a98615d94 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -1,4 +1,4 @@ -;;; color.el --- Color manipulation library -*- coding: utf-8; -*- +;;; color.el --- Color manipulation library -*- coding: utf-8; lexical-binding:t -*- ;; Copyright (C) 2010-2012 Free Software Foundation, Inc. @@ -85,7 +85,7 @@ resulting list." (g-step (/ (- (nth 1 stop) g) (1+ step-number))) (b-step (/ (- (nth 2 stop) b) (1+ step-number))) result) - (dotimes (n step-number) + (dotimes (_ step-number) (push (list (setq r (+ r r-step)) (setq g (+ g g-step)) (setq b (+ b b-step))) @@ -226,44 +226,44 @@ RED, BLUE and GREEN must be between 0 and 1, inclusive." "Convert CIE XYZ to CIE L*a*b*. WHITE-POINT specifies the (X Y Z) white point for the conversion. If omitted or nil, use `color-d65-xyz'." - (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) - (let* ((xr (/ X Xr)) - (yr (/ Y Yr)) - (zr (/ Z Zr)) - (fx (if (> xr color-cie-ε) - (expt xr (/ 1 3.0)) - (/ (+ (* color-cie-κ xr) 16) 116.0))) - (fy (if (> yr color-cie-ε) - (expt yr (/ 1 3.0)) - (/ (+ (* color-cie-κ yr) 16) 116.0))) - (fz (if (> zr color-cie-ε) - (expt zr (/ 1 3.0)) - (/ (+ (* color-cie-κ zr) 16) 116.0)))) - (list - (- (* 116 fy) 16) ; L - (* 500 (- fx fy)) ; a - (* 200 (- fy fz)))))) ; b + (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) + (xr (/ X Xr)) + (yr (/ Y Yr)) + (zr (/ Z Zr)) + (fx (if (> xr color-cie-ε) + (expt xr (/ 1 3.0)) + (/ (+ (* color-cie-κ xr) 16) 116.0))) + (fy (if (> yr color-cie-ε) + (expt yr (/ 1 3.0)) + (/ (+ (* color-cie-κ yr) 16) 116.0))) + (fz (if (> zr color-cie-ε) + (expt zr (/ 1 3.0)) + (/ (+ (* color-cie-κ zr) 16) 116.0)))) + (list + (- (* 116 fy) 16) ; L + (* 500 (- fx fy)) ; a + (* 200 (- fy fz))))) ; b (defun color-lab-to-xyz (L a b &optional white-point) "Convert CIE L*a*b* to CIE XYZ. WHITE-POINT specifies the (X Y Z) white point for the conversion. If omitted or nil, use `color-d65-xyz'." - (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) - (let* ((fy (/ (+ L 16) 116.0)) - (fz (- fy (/ b 200.0))) - (fx (+ (/ a 500.0) fy)) - (xr (if (> (expt fx 3.0) color-cie-ε) - (expt fx 3.0) - (/ (- (* fx 116) 16) color-cie-κ))) - (yr (if (> L (* color-cie-κ color-cie-ε)) - (expt (/ (+ L 16) 116.0) 3.0) - (/ L color-cie-κ))) - (zr (if (> (expt fz 3) color-cie-ε) - (expt fz 3.0) - (/ (- (* 116 fz) 16) color-cie-κ)))) - (list (* xr Xr) ; X - (* yr Yr) ; Y - (* zr Zr))))) ; Z + (pcase-let* ((`(,Xr ,Yr ,Zr) (or white-point color-d65-xyz)) + (fy (/ (+ L 16) 116.0)) + (fz (- fy (/ b 200.0))) + (fx (+ (/ a 500.0) fy)) + (xr (if (> (expt fx 3.0) color-cie-ε) + (expt fx 3.0) + (/ (- (* fx 116) 16) color-cie-κ))) + (yr (if (> L (* color-cie-κ color-cie-ε)) + (expt (/ (+ L 16) 116.0) 3.0) + (/ L color-cie-κ))) + (zr (if (> (expt fz 3) color-cie-ε) + (expt fz 3.0) + (/ (- (* 116 fz) 16) color-cie-κ)))) + (list (* xr Xr) ; X + (* yr Yr) ; Y + (* zr Zr)))) ; Z (defun color-srgb-to-lab (red green blue) "Convert RGB to CIE L*a*b*." @@ -277,67 +277,72 @@ conversion. If omitted or nil, use `color-d65-xyz'." "Return the CIEDE2000 color distance between COLOR1 and COLOR2. Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as returned by `color-srgb-to-lab' or `color-xyz-to-lab'." - (destructuring-bind (L₁ a₁ b₁) color1 - (destructuring-bind (L₂ a₂ b₂) color2 - (let* ((kL (or kL 1)) - (kC (or kC 1)) - (kH (or kH 1)) - (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0)))) - (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0)))) - (C̄ (/ (+ C₁ C₂) 2.0)) - (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) (+ (expt C̄ 7.0) (expt 25 7.0))))))) - (a′₁ (* (+ 1 G) a₁)) - (a′₂ (* (+ 1 G) a₂)) - (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0)))) - (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0)))) - (h′₁ (if (and (= b₁ 0) (= a′₁ 0)) - 0 - (let ((v (atan b₁ a′₁))) - (if (< v 0) - (+ v (* 2 float-pi)) - v)))) - (h′₂ (if (and (= b₂ 0) (= a′₂ 0)) - 0 - (let ((v (atan b₂ a′₂))) - (if (< v 0) - (+ v (* 2 float-pi)) - v)))) - (ΔL′ (- L₂ L₁)) - (ΔC′ (- C′₂ C′₁)) - (Δh′ (cond ((= (* C′₁ C′₂) 0) - 0) - ((<= (abs (- h′₂ h′₁)) float-pi) - (- h′₂ h′₁)) - ((> (- h′₂ h′₁) float-pi) - (- (- h′₂ h′₁) (* 2 float-pi))) - ((< (- h′₂ h′₁) (- float-pi)) - (+ (- h′₂ h′₁) (* 2 float-pi))))) - (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0)))) - (L̄′ (/ (+ L₁ L₂) 2.0)) - (C̄′ (/ (+ C′₁ C′₂) 2.0)) - (h̄′ (cond ((= (* C′₁ C′₂) 0) - (+ h′₁ h′₂)) - ((<= (abs (- h′₁ h′₂)) float-pi) - (/ (+ h′₁ h′₂) 2.0)) - ((< (+ h′₁ h′₂) (* 2 float-pi)) - (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0)) - ((>= (+ h′₁ h′₂) (* 2 float-pi)) - (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0)))) - (T (+ 1 - (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30))))) - (* 0.24 (cos (* h̄′ 2))) - (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6)))) - (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63))))))) - (Δθ (* (degrees-to-radians 30) (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) (degrees-to-radians 25)) 2.0))))) - (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0)))))) - (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) (sqrt (+ 20 (expt (- L̄′ 50) 2.0)))))) - (Sc (+ 1 (* C̄′ 0.045))) - (Sh (+ 1 (* 0.015 C̄′ T))) - (Rt (- (* (sin (* Δθ 2)) Rc)))) + (pcase-let* + ((`(,L₁ ,a₁ ,b₁) color1) + (`(,L₂ ,a₂ ,b₂) color2) + (kL (or kL 1)) + (kC (or kC 1)) + (kH (or kH 1)) + (C₁ (sqrt (+ (expt a₁ 2.0) (expt b₁ 2.0)))) + (C₂ (sqrt (+ (expt a₂ 2.0) (expt b₂ 2.0)))) + (C̄ (/ (+ C₁ C₂) 2.0)) + (G (* 0.5 (- 1 (sqrt (/ (expt C̄ 7.0) + (+ (expt C̄ 7.0) (expt 25 7.0))))))) + (a′₁ (* (+ 1 G) a₁)) + (a′₂ (* (+ 1 G) a₂)) + (C′₁ (sqrt (+ (expt a′₁ 2.0) (expt b₁ 2.0)))) + (C′₂ (sqrt (+ (expt a′₂ 2.0) (expt b₂ 2.0)))) + (h′₁ (if (and (= b₁ 0) (= a′₁ 0)) + 0 + (let ((v (atan b₁ a′₁))) + (if (< v 0) + (+ v (* 2 float-pi)) + v)))) + (h′₂ (if (and (= b₂ 0) (= a′₂ 0)) + 0 + (let ((v (atan b₂ a′₂))) + (if (< v 0) + (+ v (* 2 float-pi)) + v)))) + (ΔL′ (- L₂ L₁)) + (ΔC′ (- C′₂ C′₁)) + (Δh′ (cond ((= (* C′₁ C′₂) 0) + 0) + ((<= (abs (- h′₂ h′₁)) float-pi) + (- h′₂ h′₁)) + ((> (- h′₂ h′₁) float-pi) + (- (- h′₂ h′₁) (* 2 float-pi))) + ((< (- h′₂ h′₁) (- float-pi)) + (+ (- h′₂ h′₁) (* 2 float-pi))))) + (ΔH′ (* 2 (sqrt (* C′₁ C′₂)) (sin (/ Δh′ 2.0)))) + (L̄′ (/ (+ L₁ L₂) 2.0)) + (C̄′ (/ (+ C′₁ C′₂) 2.0)) + (h̄′ (cond ((= (* C′₁ C′₂) 0) + (+ h′₁ h′₂)) + ((<= (abs (- h′₁ h′₂)) float-pi) + (/ (+ h′₁ h′₂) 2.0)) + ((< (+ h′₁ h′₂) (* 2 float-pi)) + (/ (+ h′₁ h′₂ (* 2 float-pi)) 2.0)) + ((>= (+ h′₁ h′₂) (* 2 float-pi)) + (/ (+ h′₁ h′₂ (* -2 float-pi)) 2.0)))) + (T (+ 1 + (- (* 0.17 (cos (- h̄′ (degrees-to-radians 30))))) + (* 0.24 (cos (* h̄′ 2))) + (* 0.32 (cos (+ (* h̄′ 3) (degrees-to-radians 6)))) + (- (* 0.20 (cos (- (* h̄′ 4) (degrees-to-radians 63))))))) + (Δθ (* (degrees-to-radians 30) + (exp (- (expt (/ (- h̄′ (degrees-to-radians 275)) + (degrees-to-radians 25)) 2.0))))) + (Rc (* 2 (sqrt (/ (expt C̄′ 7.0) (+ (expt C̄′ 7.0) (expt 25.0 7.0)))))) + (Sl (+ 1 (/ (* 0.015 (expt (- L̄′ 50) 2.0)) + (sqrt (+ 20 (expt (- L̄′ 50) 2.0)))))) + (Sc (+ 1 (* C̄′ 0.045))) + (Sh (+ 1 (* 0.015 C̄′ T))) + (Rt (- (* (sin (* Δθ 2)) Rc)))) (sqrt (+ (expt (/ ΔL′ (* Sl kL)) 2.0) (expt (/ ΔC′ (* Sc kC)) 2.0) (expt (/ ΔH′ (* Sh kH)) 2.0) - (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))))) + (* Rt (/ ΔC′ (* Sc kC)) (/ ΔH′ (* Sh kH))))))) (defun color-clamp (value) "Make sure VALUE is a number between 0.0 and 1.0 inclusive." diff --git a/lisp/comint.el b/lisp/comint.el index 431d05b75c2..5b0eb3027e6 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3046,7 +3046,7 @@ See `comint-word'." (defun comint--unquote-argument (str) (car (comint--unquote&requote-argument str))) (define-obsolete-function-alias 'comint--unquote&expand-filename - #'comint--unquote-argument "24.2") + #'comint--unquote-argument "24.3") (defun comint-match-partial-filename () "Return the unquoted&expanded filename at point, or nil if none is found. @@ -3073,7 +3073,7 @@ Magic characters are those in `comint-file-name-quote-list'." filename (save-match-data (replace-regexp-in-string "\\\\\\(.\\)" "\\1" filename t)))) -(make-obsolete 'comint-unquote-filename nil "24.2") +(make-obsolete 'comint-unquote-filename nil "24.3") (defun comint--requote-argument (upos qstr) ;; See `completion-table-with-quoting'. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 0ee2ea4a8bf..86a19131569 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1541,7 +1541,7 @@ that option." This button will have a menu with all three reset operations." :type 'boolean :group 'custom-buffer - :version "24.2") + :version "24.3") (defcustom custom-buffer-verbose-help t "If non-nil, include explanatory text in the customization buffer." diff --git a/lisp/cus-start.el b/lisp/cus-start.el index c5f7f5b3d31..0eb8b2d63c3 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -204,7 +204,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (delete-by-moving-to-trash auto-save boolean "23.1") (auto-save-visited-file-name auto-save boolean) ;; filelock.c - (create-lockfiles files boolean "24.2") + (create-lockfiles files boolean "24.3") (temporary-file-directory ;; Darwin section added 24.1, does not seem worth :version bump. files directory nil diff --git a/lisp/custom.el b/lisp/custom.el index edb7fe2eaad..fb166dd35f7 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -611,7 +611,7 @@ property, or (ii) an alias for another customizable variable." (or (get variable 'standard-value) (get variable 'custom-autoload)))) -(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.2") +(define-obsolete-function-alias 'user-variable-p 'custom-variable-p "24.3") (defun custom-note-var-changed (variable) "Inform Custom that VARIABLE has been set (changed). diff --git a/lisp/delsel.el b/lisp/delsel.el index d6441123e04..a6435672201 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -89,7 +89,8 @@ any selection." ;; head of the kill-ring that really comes from the ;; currently active region we are going to delete. ;; That would make yank a no-op. - (when (and (string= (buffer-substring-no-properties (point) (mark)) + (when (and (string= (buffer-substring-no-properties + (point) (mark)) (car kill-ring)) (fboundp 'mouse-region-match) (mouse-region-match)) @@ -102,16 +103,15 @@ any selection." (setq this-command 'ignore)))) (type (delete-active-region) - (if (and overwrite-mode (eq this-command 'self-insert-command)) + (if (and overwrite-mode + (eq this-command 'self-insert-command)) (let ((overwrite-mode nil)) - (self-insert-command (prefix-numeric-value current-prefix-arg)) + (self-insert-command + (prefix-numeric-value current-prefix-arg)) (setq this-command 'ignore))))) - (file-supersession ;; If ask-user-about-supersession-threat signals an error, ;; stop safe_run_hooks from clearing out pre-command-hook. - (and (eq inhibit-quit 'pre-command-hook) - (setq inhibit-quit 'delete-selection-dummy)) - (signal 'file-supersession (cdr data))) + (file-supersession (message "%s" (cadr data)) (ding)) (text-read-only ;; This signal may come either from `delete-active-region' or ;; `self-insert-command' (when `overwrite-mode' is non-nil). diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 6be33066d52..34d61b80d66 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -679,23 +679,17 @@ relevant to POS." (when (cadr elt) (insert (format formatter (car elt))) (dolist (clm (cdr elt)) - (if (eq (car-safe clm) 'insert-text-button) - (progn (insert " ") (eval clm)) - (when (>= (+ (current-column) - (or (string-match-p "\n" clm) - (string-width clm)) - 1) - (window-width)) - (insert "\n") - (indent-to (1+ max-width))) - (unless (zerop (length clm)) - (insert " " clm)))) + (cond ((eq (car-safe clm) 'insert-text-button) + (insert " ") + (eval clm)) + ((not (zerop (length clm))) + (insert " " clm)))) (insert "\n")))) (when overlays (save-excursion (goto-char (point-min)) - (re-search-forward "character:[ \t\n]+") + (re-search-forward "(displayed as ") (let ((end (+ (point) (length char-description)))) (mapc (lambda (props) (let ((o (make-overlay (point) end))) diff --git a/lisp/dired.el b/lisp/dired.el index a80f48fa0c2..6684be3356c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1961,9 +1961,9 @@ If the current buffer can be edited with Wdired, (i.e. the major mode is `dired-mode'), call `wdired-change-to-wdired-mode'. Otherwise, call `toggle-read-only'." (interactive) - (if (eq major-mode 'dired-mode) + (if (derived-mode-p 'dired-mode) (wdired-change-to-wdired-mode) - (toggle-read-only nil t))) + (call-interactively 'toggle-read-only))) (defun dired-next-line (arg) "Move down lines then position at filename. @@ -3476,7 +3476,7 @@ The idea is to set this buffer-locally in special dired buffers.") (force-mode-line-update))) (define-obsolete-function-alias 'dired-sort-set-modeline - 'dired-sort-set-mode-line "24.2") + 'dired-sort-set-mode-line "24.3") (defun dired-sort-toggle-or-edit (&optional arg) "Toggle sorting by date, and refresh the Dired buffer. diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index f71554e9f66..5d9ddc1a318 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -201,7 +201,7 @@ See the documentation of `electric-buffer-list' for details." "return to buffer editing")) (define-obsolete-function-alias 'Electric-buffer-menu-mode - 'electric-buffer-menu-mode "24.2") + 'electric-buffer-menu-mode "24.3") ;; generally the same as Buffer-menu-mode-map ;; (except we don't indirect to global-map) diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 20cc38cd9c2..6c70642ba83 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -578,6 +578,7 @@ in the repository.") ("w32console.c" . "w32term.c") ("unexnt.c" . "unexw32.c") ("s/windowsnt.h" . "s/ms-w32.h") + ("s/ms-w32.h" . "inc/ms-w32.h") ("winnt.el" . "w32-fns.el") ("config.emacs" . "configure") ("configure.in" . "configure.ac") diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 3fc185dda25..e6e2d1e60e0 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -228,7 +228,8 @@ expression, in which case we want to handle forms differently." (defun autoload-find-generated-file () "Visit the autoload file for the current buffer, and return its buffer. If a buffer is visiting the desired autoload file, return it." - (let ((enable-local-variables :safe)) + (let ((enable-local-variables :safe) + (enable-local-eval nil)) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. (find-file-noselect @@ -382,7 +383,8 @@ which lists the file name and which functions are in it, etc." (emacs-lisp-mode) (setq default-directory (file-name-directory file)) (insert-file-contents file nil) - (let ((enable-local-variables :safe)) + (let ((enable-local-variables :safe) + (enable-local-eval nil)) (hack-local-variables)) (current-buffer))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 925d275386f..9b66c8ffd60 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -420,8 +420,8 @@ In interpreted code, this is entirely equivalent to `progn'." ;; nil) (make-obsolete-variable 'macro-declaration-function - 'macro-declarations-alist "24.2") + 'macro-declarations-alist "24.3") (make-obsolete 'macro-declaration-function - 'macro-declarations-alist "24.2") + 'macro-declarations-alist "24.3") ;;; byte-run.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e5df8dd112c..10bc37c6dcd 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1621,21 +1621,20 @@ This is normally set in local file variables at the end of the elisp file: "Recompile FILENAME file if it needs recompilation. This happens when its `.elc' file is older than itself. -If the `.elc' file exists and is up-to-date, normally this -function *does not* compile FILENAME. However, if the -prefix argument FORCE is set, that means do compile -FILENAME even if the destination already exists and is -up-to-date. +If the `.elc' file exists and is up-to-date, normally this function +*does not* compile FILENAME. If the prefix argument FORCE is non-nil, +however, it compiles FILENAME even if the destination already +exists and is up-to-date. -If the `.elc' file does not exist, normally this function *does -not* compile FILENAME. If ARG is 0, that means -compile the file even if it has never been compiled before. -A nonzero ARG means ask the user. +If the `.elc' file does not exist, normally this function *does not* +compile FILENAME. If optional argument ARG is 0, it compiles +the input file even if the `.elc' file does not exist. +Any other non-nil value of ARG means to ask the user. -If LOAD is set, `load' the file after compiling. +If optional argument LOAD is non-nil, loads the file after compiling. -The value returned is the value returned by `byte-compile-file', -or 'no-byte-compile if the file did not need recompilation." +If compilation is needed, this functions returns the result of +`byte-compile-file'; otherwise it returns 'no-byte-compile." (interactive (let ((file buffer-file-name) (file-name nil) @@ -1665,7 +1664,8 @@ or 'no-byte-compile if the file did not need recompilation." (if (and noninteractive (not byte-compile-verbose)) (message "Compiling %s..." filename)) (byte-compile-file filename load)) - (when load (load filename)) + (when load + (load (if (file-exists-p dest) dest filename))) 'no-byte-compile))) ;;;###autoload @@ -3578,20 +3578,22 @@ discarding." (defun byte-compile-setq-default (form) (setq form (cdr form)) - (if (> (length form) 2) - (let ((setters ())) - (while (consp form) - (push `(setq-default ,(pop form) ,(pop form)) setters)) - (byte-compile-form (cons 'progn (nreverse setters)))) - (let ((var (car form))) - (and (or (not (symbolp var)) - (macroexp--const-symbol-p var t)) - (byte-compile-warning-enabled-p 'constants) - (byte-compile-warn - "variable assignment to %s `%s'" - (if (symbolp var) "constant" "nonvariable") - (prin1-to-string var))) - (byte-compile-normal-call `(set-default ',var ,@(cdr form)))))) + (if (null form) ; (setq-default), with no arguments + (byte-compile-form nil byte-compile--for-effect) + (if (> (length form) 2) + (let ((setters ())) + (while (consp form) + (push `(setq-default ,(pop form) ,(pop form)) setters)) + (byte-compile-form (cons 'progn (nreverse setters)))) + (let ((var (car form))) + (and (or (not (symbolp var)) + (macroexp--const-symbol-p var t)) + (byte-compile-warning-enabled-p 'constants) + (byte-compile-warn + "variable assignment to %s `%s'" + (if (symbolp var) "constant" "nonvariable") + (prin1-to-string var))) + (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))) (byte-defop-compiler-1 set-default) (defun byte-compile-set-default (form) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index aa12c709b1a..86497a3c73f 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -99,8 +99,8 @@ ;;;###autoload (define-obsolete-variable-alias ;; This alias is needed for compatibility with .elc files that use defstruct - ;; and were compiled with Emacs<24.2. - 'custom-print-functions 'cl-custom-print-functions "24.2") + ;; and were compiled with Emacs<24.3. + 'custom-print-functions 'cl-custom-print-functions "24.3") ;;;###autoload (defvar cl-custom-print-functions nil diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e984d22f5d7..470ca17d3a0 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value. ;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp -;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "570bedbd0b42cfe5ead36f6983e54829") +;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9676d5517e8b9246c09fe78984c68bef") ;;; Generated autoloads from cl-macs.el (autoload 'cl-gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3c92f174a0a..81a451dbbb4 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -731,7 +731,21 @@ Valid clauses are: finally return EXPR, named NAME. \(fn CLAUSE...)" - (declare (debug (&rest &or symbolp form))) + (declare (debug (&rest &or + ;; These are usually followed by a symbol, but it can + ;; actually be any destructuring-bind pattern, which + ;; would erroneously match `form'. + [[&or "for" "as" "with" "and"] sexp] + ;; These are followed by expressions which could + ;; erroneously match `symbolp'. + [[&or "from" "upfrom" "downfrom" "to" "upto" "downto" + "above" "below" "by" "in" "on" "=" "across" + "repeat" "while" "until" "always" "never" + "thereis" "collect" "append" "nconc" "sum" + "count" "maximize" "minimize" "if" "unless" + "return"] form] + ;; Simple default, which covers 99% of the cases. + symbolp form))) (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args)))))) `(cl-block nil (while t ,@loop-args)) (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil) @@ -1668,31 +1682,86 @@ This is like `cl-flet', but for macros instead of functions. cl--old-macroexpand (symbol-function 'macroexpand))) -(defun cl--sm-macroexpand (cl-macro &optional cl-env) +(defun cl--sm-macroexpand (exp &optional env) "Special macro expander used inside `cl-symbol-macrolet'. This function replaces `macroexpand' during macro expansion of `cl-symbol-macrolet', and does the same thing as `macroexpand' except that it additionally expands symbol macros." - (let ((macroexpand-all-environment cl-env)) + (let ((macroexpand-all-environment env)) (while (progn - (setq cl-macro (funcall cl--old-macroexpand cl-macro cl-env)) - (cond - ((symbolp cl-macro) - ;; Perform symbol-macro expansion. - (when (cdr (assq (symbol-name cl-macro) cl-env)) - (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))) - ((eq 'setq (car-safe cl-macro)) - ;; Convert setq to setf if required by symbol-macro expansion. - (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f cl-env)) - (cdr cl-macro))) - (p args)) - (while (and p (symbolp (car p))) (setq p (cddr p))) - (if p (setq cl-macro (cons 'setf args)) - (setq cl-macro (cons 'setq args)) - ;; Don't loop further. - nil)))))) - cl-macro)) + (setq exp (funcall cl--old-macroexpand exp env)) + (pcase exp + ((pred symbolp) + ;; Perform symbol-macro expansion. + (when (cdr (assq (symbol-name exp) env)) + (setq exp (cadr (assq (symbol-name exp) env))))) + (`(setq . ,_) + ;; Convert setq to setf if required by symbol-macro expansion. + (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) + (cdr exp))) + (p args)) + (while (and p (symbolp (car p))) (setq p (cddr p))) + (if p (setq exp (cons 'setf args)) + (setq exp (cons 'setq args)) + ;; Don't loop further. + nil))) + (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare)) + ;; CL's symbol-macrolet treats re-bindings as candidates for + ;; expansion (turning the let into a letf if needed), contrary to + ;; Common-Lisp where such re-bindings hide the symbol-macro. + (let ((letf nil) (found nil) (nbs ())) + (dolist (binding bindings) + (let* ((var (if (symbolp binding) binding (car binding))) + (sm (assq (symbol-name var) env))) + (push (if (not (cdr sm)) + binding + (let ((nexp (cadr sm))) + (setq found t) + (unless (symbolp nexp) (setq letf t)) + (cons nexp (cdr-safe binding)))) + nbs))) + (when found + (setq exp `(,(if letf + (if (eq (car exp) 'let) 'cl-letf 'cl-letf*) + (car exp)) + ,(nreverse nbs) + ,@body))))) + ;; FIXME: The behavior of CL made sense in a dynamically scoped + ;; language, but for lexical scoping, Common-Lisp's behavior might + ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t + ;; lexical-let), so maybe we should adjust the behavior based on + ;; the use of lexical-binding. + ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare)) + ;; (let ((nbs ()) (found nil)) + ;; (dolist (binding bindings) + ;; (let* ((var (if (symbolp binding) binding (car binding))) + ;; (name (symbol-name var)) + ;; (val (and found (consp binding) (eq 'let* (car exp)) + ;; (list (macroexpand-all (cadr binding) + ;; env))))) + ;; (push (if (assq name env) + ;; ;; This binding should hide its symbol-macro, + ;; ;; but given the way macroexpand-all works, we + ;; ;; can't prevent application of `env' to the + ;; ;; sub-expressions, so we need to α-rename this + ;; ;; variable instead. + ;; (let ((nvar (make-symbol + ;; (copy-sequence name)))) + ;; (setq found t) + ;; (push (list name nvar) env) + ;; (cons nvar (or val (cdr-safe binding)))) + ;; (if val (cons var val) binding)) + ;; nbs))) + ;; (when found + ;; (setq exp `(,(car exp) + ;; ,(nreverse nbs) + ;; ,@(macroexp-unprogn + ;; (macroexpand-all (macroexp-progn body) + ;; env))))) + ;; nil)) + ))) + exp)) ;;;###autoload (defmacro cl-symbol-macrolet (bindings &rest body) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index dda3e12dae3..e601f55bd9f 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -452,7 +452,7 @@ definitions, or lack thereof). \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (declare (indent 1) (debug cl-flet) - (obsolete "Use either `cl-flet' or `cl-letf'." "24.2")) + (obsolete "Use either `cl-flet' or `cl-letf'." "24.3")) `(letf ,(mapcar (lambda (x) (if (or (and (fboundp (car x)) @@ -480,7 +480,7 @@ will not work - use `labels' instead" (symbol-name (car x)))) "Make temporary function bindings. Like `cl-labels' except that the lexical scoping is handled via `lexical-let' rather than relying on `lexical-binding'." - (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.2")) + (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.3")) (let ((vars nil) (sets nil) (newenv macroexpand-all-environment)) (dolist (binding bindings) ;; It's important that (not (eq (symbol-name var1) (symbol-name var2))) @@ -521,7 +521,7 @@ Like `cl-letf', but with some extra backward compatibility." (defun cl--gv-adapt (cl-gv do) ;; This function is used by all .elc files that use define-setf-expander and - ;; were compiled with Emacs>=24.2. + ;; were compiled with Emacs>=24.3. (let ((vars (nth 0 cl-gv)) (vals (nth 1 cl-gv)) (binds ()) @@ -632,7 +632,7 @@ Example: ;; `(,witness ,getter ,(funcall setter witness))))) ;; ...find "let prefix" of expansion, extract getter and setter from ;; ...the rest, and build the 5-tuple)) -(make-obsolete 'get-setf-method 'gv-letplace "24.2") +(make-obsolete 'get-setf-method 'gv-letplace "24.3") (defmacro define-modify-macro (name arglist func &optional doc) "Define a `setf'-like modify macro. @@ -653,47 +653,52 @@ from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" ;;; Additional compatibility code. ;; For names that were clean but really aren't needed any more. -(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.2") +(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3") (define-obsolete-variable-alias 'cl-macro-environment - 'macroexpand-all-environment "24.2") -(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.2") + 'macroexpand-all-environment "24.3") +(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.3") ;;; Hash tables. ;; This is just kept for compatibility with code byte-compiled by Emacs-20. ;; No idea if this might still be needed. (defun cl-not-hash-table (x &optional y &rest _z) - (declare (obsolete nil "24.2")) + (declare (obsolete nil "24.3")) (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x)))) (defvar cl-builtin-gethash (symbol-function 'gethash)) -(make-obsolete-variable 'cl-builtin-gethash nil "24.2") +(make-obsolete-variable 'cl-builtin-gethash nil "24.3") (defvar cl-builtin-remhash (symbol-function 'remhash)) -(make-obsolete-variable 'cl-builtin-remhash nil "24.2") +(make-obsolete-variable 'cl-builtin-remhash nil "24.3") (defvar cl-builtin-clrhash (symbol-function 'clrhash)) -(make-obsolete-variable 'cl-builtin-clrhash nil "24.2") +(make-obsolete-variable 'cl-builtin-clrhash nil "24.3") (defvar cl-builtin-maphash (symbol-function 'maphash)) -(make-obsolete-variable 'cl-builtin-maphash nil "24.2") -(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.2") -(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.2") -(define-obsolete-function-alias 'cl-gethash 'gethash "24.2") -(define-obsolete-function-alias 'cl-puthash 'puthash "24.2") -(define-obsolete-function-alias 'cl-remhash 'remhash "24.2") -(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.2") -(define-obsolete-function-alias 'cl-maphash 'maphash "24.2") -(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.2") -(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.2") -(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.2") +(make-obsolete-variable 'cl-builtin-maphash nil "24.3") +(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.3") +(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.3") +(define-obsolete-function-alias 'cl-gethash 'gethash "24.3") +(define-obsolete-function-alias 'cl-puthash 'puthash "24.3") +(define-obsolete-function-alias 'cl-remhash 'remhash "24.3") +(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.3") +(define-obsolete-function-alias 'cl-maphash 'maphash "24.3") +(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.3") +(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.3") +(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.3") + +(define-obsolete-function-alias 'cl-map-keymap-recursively + 'cl--map-keymap-recursively "24.3") +(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3") +(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3") (defun cl-maclisp-member (item list) - (declare (obsolete member "24.2")) + (declare (obsolete member "24.3")) (while (and list (not (equal item (car list)))) (setq list (cdr list))) list) ;; Used in the expansion of the old `defstruct'. (defun cl-struct-setf-expander (x name accessor pred-form pos) - (declare (obsolete nil "24.2")) + (declare (obsolete nil "24.3")) (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--"))) (list (list temp) (list x) (list store) `(progn diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 8e96d95c5dd..c3616c6e490 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -362,10 +362,11 @@ If FIX is non-nil, run `copyright-fix-years' instead." (dolist (file (directory-files directory t match nil)) (unless (file-directory-p file) (message "Updating file `%s'" file) - (find-file file) - (let ((inhibit-read-only t) - (enable-local-variables :safe) - copyright-query) + ;; FIXME we should not use find-file+save+kill. + (let ((enable-local-variables :safe) + (enable-local-eval nil)) + (find-file file)) + (let ((inhibit-read-only t)) (if fix (copyright-fix-years) (copyright-update))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index bbf0757c3bc..7fcd339d6d2 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -248,7 +248,7 @@ If the result is non-nil, then break. Errors are ignored." (progn (and (symbolp indirect) (setq indirect - (function-get indirect 'edebug-form-spec 'autoload)))) + (function-get indirect 'edebug-form-spec 'macro)))) ;; (edebug-trace "indirection: %s" edebug-form-spec) (setq edebug-form-spec indirect)) edebug-form-spec @@ -3742,7 +3742,7 @@ By default, loading the `edebug' library causes these bindings to be installed in `emacs-lisp-mode-map'.") (define-obsolete-variable-alias 'gud-inhibit-global-bindings - 'edebug-inhibit-emacs-lisp-mode-bindings "24.2") + 'edebug-inhibit-emacs-lisp-mode-bindings "24.3") ;; Global GUD bindings for all emacs-lisp-mode buffers. (unless edebug-inhibit-emacs-lisp-mode-bindings diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 5f4be78b082..9304f0e3918 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -2554,7 +2554,7 @@ This is usually a symbol that starts with `:'." (defsetf eieio-oref eieio-oset) (if (eval-when-compile (fboundp 'gv-define-expander)) - ;; Not needed for Emacs>=24.2 since gv.el's setf expands macros and + ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and ;; follows aliases. nil (defsetf slot-value eieio-oset) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index e29407f5a8b..666e31f690f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -117,10 +117,15 @@ It has `lisp-mode-abbrev-table' as its parent." (purecopy (concat "^\\s-*(" (eval-when-compile (regexp-opt - '("defvar" "defconst" "defconstant" "defcustom" + '("defconst" "defconstant" "defcustom" "defparameter" "define-symbol-macro") t)) "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)")) 2) + ;; For `defvar', we ignore (defvar FOO) constructs. + (list (purecopy "Variables") + (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" + "[[:space:]\n]+[^)]")) + 1) (list (purecopy "Types") (purecopy (concat "^\\s-*(" (eval-when-compile @@ -771,7 +776,12 @@ Reinitialize the face according to the `defface' specification." (default-boundp (eval (nth 1 form) lexical-binding))) ;; Force variable to be bound. (set-default (eval (nth 1 form) lexical-binding) - (eval (nth 1 (nth 2 form)) lexical-binding)) + ;; The second arg is an expression that evaluates to + ;; an expression. The second evaluation is the one + ;; normally performed not be normal execution but by + ;; custom-initialize-set (for example), which does not + ;; use lexical-binding. + (eval (eval (nth 2 form) lexical-binding))) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 72e3c398dc0..8c64327c0ff 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -234,7 +234,8 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (defun regexp-opt-charset (chars) - "Return a regexp to match a character in CHARS." + "Return a regexp to match a character in CHARS. +CHARS should be a list of characters." ;; The basic idea is to find character ranges. Also we take care in the ;; position of character set meta characters in the character set regexp. ;; diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index c246d0235f6..774c6cd2c38 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -35,9 +35,8 @@ ;; that the `repeat' form can't have multiple regexp args. ;; Now alternative forms are provided for a degree of compatibility -;; with Shivers' attempted definitive SRE notation -;; . SRE forms not -;; catered for include: dsm, uncase, w/case, w/nocase, ,@, +;; with Olin Shivers' attempted definitive SRE notation. SRE forms +;; not catered for include: dsm, uncase, w/case, w/nocase, ,@, ;; ,, (word ...), word+, posix-string, and character class forms. ;; Some forms are inconsistent with SRE, either for historical reasons ;; or because of the implementation -- simple translation into Emacs @@ -108,7 +107,9 @@ ;;; Code: -(defconst rx-constituents +;; FIXME: support macros. + +(defvar rx-constituents ;Not `const' because some modes extend it. '((and . (rx-and 1 nil)) (seq . and) ; SRE (: . and) ; SRE @@ -832,27 +833,28 @@ If FORM is '(minimal-match FORM1)', non-greedy versions of `*', FORM is a regular expression in sexp form. RX-PARENT shows which type of expression calls and controls putting of shy groups around the result and some more in other functions." - (if (stringp form) - (rx-group-if (regexp-quote form) - (if (and (eq rx-parent '*) (< 1 (length form))) - rx-parent)) - (cond ((integerp form) - (regexp-quote (char-to-string form))) - ((symbolp form) - (let ((info (rx-info form nil))) - (cond ((stringp info) - info) - ((null info) - (error "Unknown rx form `%s'" form)) - (t - (funcall (nth 0 info) form))))) - ((consp form) - (let ((info (rx-info (car form) 'head))) - (unless (consp info) - (error "Unknown rx form `%s'" (car form))) - (funcall (nth 0 info) form))) - (t - (error "rx syntax error at `%s'" form))))) + (cond + ((stringp form) + (rx-group-if (regexp-quote form) + (if (and (eq rx-parent '*) (< 1 (length form))) + rx-parent))) + ((integerp form) + (regexp-quote (char-to-string form))) + ((symbolp form) + (let ((info (rx-info form nil))) + (cond ((stringp info) + info) + ((null info) + (error "Unknown rx form `%s'" form)) + (t + (funcall (nth 0 info) form))))) + ((consp form) + (let ((info (rx-info (car form) 'head))) + (unless (consp info) + (error "Unknown rx form `%s'" (car form))) + (funcall (nth 0 info) form))) + (t + (error "rx syntax error at `%s'" form)))) ;;;###autoload diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index 6d91238f2b1..5343d499efb 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -86,7 +86,7 @@ for both actions (NOT RECOMMENDED)." The functions get one argument, the first locked buffer found." :type 'hook :group 'emacs-lock - :version "24.2") + :version "24.3") (defvar emacs-lock-mode nil "If non-nil, the current buffer is locked. diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el index d29736d6860..c9822b7ec27 100644 --- a/lisp/emulation/crisp.el +++ b/lisp/emulation/crisp.el @@ -177,7 +177,7 @@ nice to the world.") :group 'crisp) (define-obsolete-variable-alias 'crisp-mode-modeline-string - 'crisp-mode-mode-line-string "24.2") + 'crisp-mode-mode-line-string "24.3") ;;;###autoload (defcustom crisp-mode nil diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el index 29020a4bdf5..c313a97f726 100644 --- a/lisp/emulation/vip.el +++ b/lisp/emulation/vip.el @@ -307,10 +307,10 @@ If nil then it is bound to `delete-backward-char'." (defmacro vip-loop (count body) "(COUNT BODY) Execute BODY COUNT times." - (list 'let (list (list 'count count)) - (list 'while (list '> 'count 0) - body - (list 'setq 'count (list '1- 'count))))) + `(let ((count ,count)) + (while (> count 0) + ,body + (setq count (1- count))))) (defun vip-push-mark-silent (&optional location) "Set mark at LOCATION (point, by default) and push old mark on mark ring. diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 9f0826bf515..c482a88de1a 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -96,6 +96,10 @@ In all likelihood, you don't need to bother with this setting." ;;; Macros (defmacro viper-deflocalvar (var default-value &optional documentation) + "Define VAR as a buffer-local variable. +DEFAULT-VALUE is the default value, and DOCUMENTATION is the +docstring. The variable becomes buffer-local whenever set." + (declare (indent defun)) `(progn (defvar ,var ,default-value ,(format "%s\n\(buffer local\)" documentation)) @@ -103,6 +107,7 @@ In all likelihood, you don't need to bother with this setting." ;; (viper-loop COUNT BODY) Execute BODY COUNT times. (defmacro viper-loop (count &rest body) + (declare (indent defun)) `(let ((count ,count)) (while (> count 0) ,@body diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 37758048258..b87cfd41f61 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,9 @@ +2012-08-06 Julien Danjou + + * erc-match.el (erc-match-exclude-server-buffer) + (erc-match-message): Add new option to exclude server buffer from + matching. + 2012-07-21 Julien Danjou * erc-notifications.el: New file. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index cce24e67cf4..5da3009c854 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -396,7 +396,7 @@ isn't displayed." (defcustom erc-server-timestamp-format "%Y-%m-%d %T" "Timestamp format used with server response messages. This string is processed using `format-time-string'." - :version "24.2" + :version "24.3" :type 'string :group 'erc-server) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 66256ee270e..4d0534d3d5e 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -1105,7 +1105,7 @@ Each function is called with two arguments: the ERC process and the unprocessed output.") (define-obsolete-variable-alias 'erc-dcc-chat-filter-hook - 'erc-dcc-chat-filter-functions "24.2") + 'erc-dcc-chat-filter-functions "24.3") (defvar erc-dcc-chat-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 9fbe9544677..8daf9be2b14 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -232,6 +232,14 @@ current-nick, keyword, pal, dangerous-host, fool" :group 'erc-match :type 'hook) +(defcustom erc-match-exclude-server-buffer nil + "If true, don't perform match on the server buffer; this is +useful for excluding all the things like MOTDs from the server +and other miscellaneous functions." + :group 'erc-match + :version "24.3" + :type 'boolean) + ;; Internal variables: ;; This is exactly the same as erc-button-syntax-table. Should we @@ -449,7 +457,9 @@ Use this defun with `erc-insert-modify-hook'." (+ 2 nick-end) (point-min)) (point-max)))) - (when vector + (when (and vector + (not (and erc-track-exclude-server-buffer + (erc-server-buffer-p)))) (mapc (lambda (match-type) (goto-char (point-min)) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 603da6f2e30..52df1587d5f 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -226,20 +226,15 @@ causing the user to wonder if anything's really going on..." Adds the given PATH to $PATH.") (if args (progn - (if prepend - (setq args (nreverse args))) - (while args - (setenv "PATH" - (if prepend - (concat (car args) path-separator - (getenv "PATH")) - (concat (getenv "PATH") path-separator - (car args)))) - (setq args (cdr args)))) - (let ((paths (parse-colon-path (getenv "PATH")))) - (while paths - (eshell-printn (car paths)) - (setq paths (cdr paths))))))) + (setq eshell-path-env (getenv "PATH") + args (mapconcat 'identity args path-separator) + eshell-path-env + (if prepend + (concat args path-separator eshell-path-env) + (concat eshell-path-env path-separator args))) + (setenv "PATH" eshell-path-env)) + (dolist (dir (parse-colon-path (getenv "PATH"))) + (eshell-printn dir))))) (put 'eshell/addpath 'eshell-no-numeric-conversions t) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 9da3f8e2e79..8a9107e5470 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -199,7 +199,7 @@ This is used by `eshell-watch-for-password-prompt'." :group 'eshell-mode) (define-obsolete-variable-alias 'eshell-status-in-modeline - 'eshell-status-in-mode-line "24.2") + 'eshell-status-in-mode-line "24.3") (defvar eshell-first-time-p t "A variable which is non-nil the first time Eshell is loaded.") diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index a1717756696..c663de3f40d 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -241,37 +241,31 @@ shells such as bash, zsh, rc, 4dos." ;; The following user options modify the behavior of Eshell overall. (defvar eshell-buffer-name) -(defsubst eshell-add-to-window-buffer-names () +(defun eshell-add-to-window-buffer-names () "Add `eshell-buffer-name' to `same-window-buffer-names'." (add-to-list 'same-window-buffer-names eshell-buffer-name)) +(make-obsolete 'eshell-add-to-window-buffer-names + "no longer needed." "24.3") -(defsubst eshell-remove-from-window-buffer-names () +(defun eshell-remove-from-window-buffer-names () "Remove `eshell-buffer-name' from `same-window-buffer-names'." (setq same-window-buffer-names (delete eshell-buffer-name same-window-buffer-names))) +(make-obsolete 'eshell-remove-from-window-buffer-names + "no longer needed." "24.3") (defcustom eshell-load-hook nil "A hook run once Eshell has been loaded." :type 'hook :group 'eshell) -(defcustom eshell-unload-hook - '(eshell-remove-from-window-buffer-names - eshell-unload-all-modules) +(defcustom eshell-unload-hook '(eshell-unload-all-modules) "A hook run when Eshell is unloaded from memory." :type 'hook :group 'eshell) (defcustom eshell-buffer-name "*eshell*" "The basename used for Eshell buffers." - :set (lambda (symbol value) - ;; remove the old value of `eshell-buffer-name', if present - (if (boundp 'eshell-buffer-name) - (eshell-remove-from-window-buffer-names)) - (set symbol value) - ;; add the new value - (eshell-add-to-window-buffer-names) - value) :type 'string :group 'eshell) @@ -307,13 +301,8 @@ buffer selected (or created)." (generate-new-buffer eshell-buffer-name)) (t (get-buffer-create eshell-buffer-name))))) - ;; Simply calling `pop-to-buffer' will not mimic the way that - ;; shell-mode buffers appear, since they always reuse the same - ;; window that that command was invoked from. To achieve this, - ;; it's necessary to add `eshell-buffer-name' to the variable - ;; `same-window-buffer-names', which is done when Eshell is loaded (cl-assert (and buf (buffer-live-p buf))) - (pop-to-buffer buf) + (pop-to-buffer-same-window buf) (unless (eq major-mode 'eshell-mode) (eshell-mode)) buf)) diff --git a/lisp/ffap.el b/lisp/ffap.el index 3d1f402ab6c..d0f3b639cf2 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -160,7 +160,7 @@ If the value is a list of strings, that specifies a list of URL schemes (e.g. \"ftp\"); in that case, only convert those URLs." :type '(choice (repeat string) boolean) :group 'ffap - :version "24.2") + :version "24.3") (defcustom ffap-ftp-default-user "anonymous" "User name in ftp file names generated by `ffap-host-to-path'. diff --git a/lisp/files.el b/lisp/files.el index 7fc7ccc8553..5caa4681884 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1000,7 +1000,7 @@ Tip: You can use this expansion of remote identifier components (setq list (cdr list)))) (or (car list) "ssh"))) "Program to use to execute commands on a remote host (e.g. ssh or rsh)." - :version "24.2" ; ssh rather than rsh, etc + :version "24.3" ; ssh rather than rsh, etc :initialize 'custom-initialize-delay :group 'environment :type 'file) @@ -1079,9 +1079,7 @@ containing it, until no links are left at any level. (delq (rassq 'ange-ftp-completion-hook-function tem) tem))))) (or prev-dirs (setq prev-dirs (list nil))) - ;; andrewi@harlequin.co.uk - none of the following code (except for - ;; invoking the file-name handler) currently applies on Windows - ;; (ie. there are no native symlinks), but there is an issue with + ;; andrewi@harlequin.co.uk - on Windows, there is an issue with ;; case differences being ignored by the OS, and short "8.3 DOS" ;; name aliases existing for all files. (The short names are not ;; reported by directory-files, but can be used to refer to files.) @@ -1091,31 +1089,15 @@ containing it, until no links are left at any level. ;; it is stored on disk (expanding short name aliases with the full ;; name in the process). (if (eq system-type 'windows-nt) - (let ((handler (find-file-name-handler filename 'file-truename))) - ;; For file name that has a special handler, call handler. - ;; This is so that ange-ftp can save time by doing a no-op. - (if handler - (setq filename (funcall handler 'file-truename filename)) - ;; If filename contains a wildcard, newname will be the old name. - (unless (string-match "[[*?]" filename) - ;; If filename exists, use the long name. If it doesn't exist, - ;; drill down until we find a directory that exists, and use - ;; the long name of that, with the extra non-existent path - ;; components concatenated. - (let ((longname (w32-long-file-name filename)) - missing rest) - (if longname - (setq filename longname) - ;; Include the preceding directory separator in the missing - ;; part so subsequent recursion on the rest works. - (setq missing (concat "/" (file-name-nondirectory filename))) - (let ((length (length missing))) - (setq rest - (if (> length (length filename)) - "" - (substring filename 0 (- length))))) - (setq filename (concat (file-truename rest) missing)))))) - (setq done t))) + (unless (string-match "[[*?]" filename) + ;; If filename exists, use its long name. If it doesn't + ;; exist, the recursion below on the directory of filename + ;; will drill down until we find a directory that exists, + ;; and use the long name of that, with the extra + ;; non-existent path components concatenated. + (let ((longname (w32-long-file-name filename))) + (if longname + (setq filename longname))))) ;; If this file directly leads to a link, process that iteratively ;; so that we don't use lots of stack. @@ -1135,6 +1117,8 @@ containing it, until no links are left at any level. (setq dirfile (directory-file-name dir)) ;; If these are equal, we have the (or a) root directory. (or (string= dir dirfile) + (and (memq system-type '(windows-nt ms-dos cygwin)) + (eq (compare-strings dir 0 nil dirfile 0 nil t) t)) ;; If this is the same dir we last got the truename for, ;; save time--don't recalculate. (if (assoc dir (car prev-dirs)) @@ -1530,7 +1514,11 @@ expand wildcards (if any) and replace the file with multiple files." (other-window 1) (find-alternate-file filename wildcards)))) -(defvar kill-buffer-hook) ; from buffer.c +;; Defined and used in buffer.c, but not as a DEFVAR_LISP. +(defvar kill-buffer-hook nil + "Hook run when a buffer is killed. +The buffer being killed is current while the hook is running. +See `kill-buffer'.") (defun find-alternate-file (filename &optional wildcards) "Find file FILENAME, select its buffer, kill previous buffer. @@ -1633,7 +1621,7 @@ Choose the buffer's name using `generate-new-buffer-name'." "Regexp to match the automounter prefix in a directory name." :group 'files :type 'regexp) -(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.2") +(make-obsolete-variable 'automount-dir-prefix 'directory-abbrev-alist "24.3") (defvar abbreviated-home-dir nil "The user's homedir abbreviated according to `directory-abbrev-alist'.") @@ -2750,7 +2738,7 @@ we don't actually set it to the same mode the buffer already has." (cadr mode)) (setq mode (car mode) name (substring name 0 (match-beginning 0))) - (setq name)) + (setq name nil)) (when mode (set-auto-mode-0 mode keep-mode-if-same) (setq done t)))))) @@ -3114,11 +3102,15 @@ DIR-NAME is the name of the associated directory. Otherwise it is nil." ;; Obey `enable-local-eval'. ((eq var 'eval) (when enable-local-eval - (push elt all-vars) - (or (eq enable-local-eval t) - (hack-one-local-variable-eval-safep (eval (quote val))) - (safe-local-variable-p var val) - (push elt unsafe-vars)))) + (let ((safe (or (hack-one-local-variable-eval-safep val) + ;; In case previously marked safe (bug#5636). + (safe-local-variable-p var val)))) + ;; If not safe and e-l-v = :safe, ignore totally. + (when (or safe (not (eq enable-local-variables :safe))) + (push elt all-vars) + (or (eq enable-local-eval t) + safe + (push elt unsafe-vars)))))) ;; Ignore duplicates (except `mode') in the present list. ((and (assq var all-vars) (not (eq var 'mode))) nil) ;; Accept known-safe variables. @@ -3648,7 +3640,7 @@ is found. Returns the new class name." (defcustom enable-remote-dir-locals nil "Non-nil means dir-local variables will be applied to remote files." - :version "24.2" + :version "24.3" :type 'boolean :group 'find-file) @@ -4500,7 +4492,8 @@ Before and after saving the buffer, this function runs (or buffer-file-name (let ((filename (expand-file-name - (read-file-name "File to save in: ") nil))) + (read-file-name "File to save in: " + nil (expand-file-name (buffer-name)))))) (if (file-exists-p filename) (if (file-directory-p filename) ;; Signal an error if the user specified the name of an diff --git a/lisp/frame.el b/lisp/frame.el index 778028390e7..01225639ecf 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1051,10 +1051,12 @@ If FRAME is omitted, describe the currently selected frame." (define-obsolete-function-alias 'set-default-font 'set-frame-font "23.1") -(defun set-frame-font (font-name &optional keep-size frames) - "Set the default font to FONT-NAME. +(defun set-frame-font (font &optional keep-size frames) + "Set the default font to FONT. When called interactively, prompt for the name of a font, and use -that font on the selected frame. +that font on the selected frame. When called from Lisp, FONT +should be a font name (a string), a font object, font entity, or +font spec. If KEEP-SIZE is nil, keep the number of frame lines and columns fixed. If KEEP-SIZE is non-nil (or with a prefix argument), try @@ -1076,7 +1078,7 @@ this session\", so that the font is applied to future frames." nil nil nil nil (frame-parameter nil 'font)))) (list font current-prefix-arg nil))) - (when (stringp font-name) + (when (or (stringp font) (fontp font)) (let* ((this-frame (selected-frame)) ;; FRAMES nil means affect the selected frame. (frame-list (cond ((null frames) @@ -1097,7 +1099,7 @@ this session\", so that the font is applied to future frames." ;; (:width, :weight, etc.) so reset them too (Bug#2476). (set-face-attribute 'default f :width 'normal :weight 'normal - :slant 'normal :font font-name) + :slant 'normal :font font) (if keep-size (modify-frame-parameters f @@ -1649,7 +1651,7 @@ terminals, cursor blinking is controlled by the terminal." ;; Misc. -;; Only marked as obsolete in 24.2. +;; Only marked as obsolete in 24.3. (define-obsolete-variable-alias 'automatic-hscrolling 'auto-hscroll-mode "22.1") diff --git a/lisp/fringe.el b/lisp/fringe.el index 329370b5fe5..6ff27a71355 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -105,8 +105,8 @@ This is usually invoked when setting `fringe-mode' via customize." (defun set-fringe-mode (value) "Set `fringe-mode' to VALUE and put the new value into effect. See `fringe-mode' for possible values and their effect." + (fringe--check-style value) (setq fringe-mode value) - (when fringe-mode-explicit (modify-all-frames-parameters (list (cons 'left-fringe (if (consp fringe-mode) @@ -116,6 +116,14 @@ See `fringe-mode' for possible values and their effect." (cdr fringe-mode) fringe-mode)))))) +(defun fringe--check-style (style) + (or (null style) + (integerp style) + (and (consp style) + (or (null (car style)) (integerp (car style))) + (or (null (cdr style)) (integerp (cdr style)))) + (error "Invalid fringe style `%s'" style))) + ;; For initialization of fringe-mode, take account of changes ;; made explicitly to default-frame-alist. (defun fringe-mode-initialize (symbol value) @@ -141,24 +149,40 @@ See `fringe-mode' for possible values and their effect." ("right-only" . (0 . nil)) ("left-only" . (nil . 0)) ("half-width" . (4 . 4)) - ("minimal" . (1 . 1)))) + ("minimal" . (1 . 1))) + "Alist mapping fringe mode names to fringe widths. +Each list element has the form (NAME . WIDTH), where NAME is a +mnemonic fringe mode name (a symbol) and WIDTH is one of the +following: +- nil, which means the default width (8 pixels). +- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are + respectively the left and right fringe widths in pixels, or + nil (meaning to disable that fringe). +- a single integer, which specifies the pixel widths of both + fringes.") (defcustom fringe-mode nil - "Specify appearance of fringes on all frames. -This variable can be nil (the default) meaning the fringes should have -the default width (8 pixels), it can be an integer value specifying -the width of both left and right fringe (where 0 means no fringe), or -a cons cell where car indicates width of left fringe and cdr indicates -width of right fringe (where again 0 can be used to indicate no -fringe). -Note that the actual width may be rounded up to ensure that the sum of -the width of the left and right fringes is a multiple of the frame's -character width. However, a fringe width of 0 is never rounded. -To set this variable in a Lisp program, use `set-fringe-mode' to make -it take real effect. -Setting the variable with a customization buffer also takes effect. -If you only want to modify the appearance of the fringe in one frame, -you can use the interactive function `set-fringe-style'." + "Default appearance of fringes on all frames. +The Lisp value should be one of the following: +- nil, which means the default width (8 pixels). +- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are + respectively the left and right fringe widths in pixels, or + nil (meaning to disable that fringe). +- a single integer, which specifies the pixel widths of both + fringes. +Note that the actual width may be rounded up to ensure that the +sum of the width of the left and right fringes is a multiple of +the frame's character width. However, a fringe width of 0 is +never rounded. + +When setting this variable from Customize, the user can choose +from the mnemonic fringe mode names defined in `fringe-styles'. + +When setting this variable in a Lisp program, call +`set-fringe-mode' afterward to make it take real effect. + +To modify the appearance of the fringe in a specific frame, use +the interactive function `set-fringe-style'." :type `(choice ,@ (mapcar (lambda (style) (let ((name @@ -195,30 +219,31 @@ frame parameter is used." ": ") fringe-styles nil t)) (style (assoc (downcase mode) fringe-styles))) - (if style (cdr style) - (if (eq 0 (cdr (assq 'left-fringe - (if all-frames - default-frame-alist - (frame-parameters (selected-frame)))))) - nil - 0)))) + (cond + (style + (cdr style)) + ((not (eq 0 (cdr (assq 'left-fringe + (if all-frames + default-frame-alist + (frame-parameters)))))) + 0)))) (defun fringe-mode (&optional mode) "Set the default appearance of fringes on all frames. +When called interactively, query the user for MODE; valid values +are `no-fringes', `default', `left-only', `right-only', `minimal' +and `half-width'. See `fringe-styles'. -When called interactively, query the user for MODE. Valid values -for MODE include `no-fringes', `default', `left-only', `right-only', -`minimal' and `half-width'. - -When used in a Lisp program, MODE can be a cons cell where the -integer in car specifies the left fringe width and the integer in -cdr specifies the right fringe width. MODE can also be a single -integer that specifies both the left and the right fringe width. -If a fringe width specification is nil, that means to use the -default width (8 pixels). This command may round up the left and -right width specifications to ensure that their sum is a multiple -of the character width of a frame. It never rounds up a fringe -width of 0. +When used in a Lisp program, MODE should be one of these: +- nil, which means the default width (8 pixels). +- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are + respectively the left and right fringe widths in pixels, or + nil (meaning to disable that fringe). +- a single integer, which specifies the pixel widths of both + fringes. +This command may round up the left and right width specifications +to ensure that their sum is a multiple of the character width of +a frame. It never rounds up a fringe width of 0. Fringe widths set by `set-window-fringes' override the default fringe widths set by this command. This command applies to all @@ -230,26 +255,27 @@ frame only, see the command `set-fringe-style'." (defun set-fringe-style (&optional mode) "Set the default appearance of fringes on the selected frame. +When called interactively, query the user for MODE; valid values +are `no-fringes', `default', `left-only', `right-only', `minimal' +and `half-width'. See `fringe-styles'. -When called interactively, query the user for MODE. Valid values -for MODE include `none', `default', `left-only', `right-only', -`minimal' and `half'. - -When used in a Lisp program, MODE can be a cons cell where the -integer in car specifies the left fringe width and the integer in -cdr specifies the right fringe width. MODE can also be a single -integer that specifies both the left and the right fringe width. -If a fringe width specification is nil, that means to use the -default width (8 pixels). This command may round up the left and -right width specifications to ensure that their sum is a multiple -of the character width of a frame. It never rounds up a fringe -width of 0. +When used in a Lisp program, MODE should be one of these: +- nil, which means the default width (8 pixels). +- a cons cell (LEFT . RIGHT), where LEFT and RIGHT are + respectively the left and right fringe widths in pixels, or + nil (meaning to disable that fringe). +- a single integer, which specifies the pixel widths of both + fringes. +This command may round up the left and right width specifications +to ensure that their sum is a multiple of the character width of +a frame. It never rounds up a fringe width of 0. Fringe widths set by `set-window-fringes' override the default fringe widths set by this command. If you want to set the default appearance of fringes on all frames, see the command `fringe-mode'." (interactive (list (fringe-query-style))) + (fringe--check-style mode) (modify-frame-parameters (selected-frame) (list (cons 'left-fringe (if (consp mode) (car mode) mode)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index d7bedfb3260..df35e998c31 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,28 @@ +2012-08-14 Chong Yidong + + * gnus-art.el (article-display-face): Handle failure in + gnus-create-image (Bug#11802). + +2012-08-10 Stefan Monnier + + * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-groups): + Use defsetf. + +2012-08-10 Daiki Ueno + + * auth-source.el: (auth-source-plstore-search) + (auth-source-secrets-search): Ignore :require and :type in search spec. + +2012-08-06 Julien Danjou + + * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler): + Remove autoload, already handled by gnus.el. + +2012-08-05 Julien Danjou + + * gnus-demon.el (gnus-demon-add-handler, gnus-demon-remove-handler): + Add autoload. + 2012-07-31 Katsumi Yamaoka * gnus.el (gnus-valid-select-methods): Fix custom type. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 79358b401b8..262da447358 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -1532,7 +1532,7 @@ authentication tokens: (let* ((coll (oref backend source)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :label)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) @@ -1787,7 +1787,7 @@ entries for git.gnus.org: "Search the PLSTORE; spec is like `auth-source'." (let* ((store (oref backend data)) (max (or max 5000)) ; sanity check: default to stop at 5K - (ignored-keys '(:create :delete :max :backend :require)) + (ignored-keys '(:create :delete :max :backend :label :require :type)) (search-keys (loop for i below (length spec) by 2 unless (memq (nth i spec) ignored-keys) collect (nth i spec))) diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 525008c351f..60d6102f7c0 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -354,23 +354,11 @@ manipulated as follows: (func LIST): Returns VALUE1 (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1." `(progn (defmacro ,name (category) - (list (quote cdr) (list (quote assq) - (quote (quote ,prop-name)) category))) + (list 'cdr (list 'assq '',prop-name category))) - (define-setf-method ,name (category) - (let* ((--category--temp-- (make-symbol "--category--")) - (--value--temp-- (make-symbol "--value--"))) - (list (list --category--temp--) ; temporary-variables - (list category) ; value-forms - (list --value--temp--) ; store-variables - (let* ((category --category--temp--) ; store-form - (value --value--temp--)) - (list (quote gnus-agent-cat-set-property) - category - (quote (quote ,prop-name)) - value)) - (list (quote ,name) --category--temp--) ; access-form - ))))) + (defsetf ,name (category) (value) + (list 'gnus-agent-cat-set-property + category '',prop-name value)))) ) (defmacro gnus-agent-cat-name (category) @@ -398,22 +386,10 @@ manipulated as follows: gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) -;; This form is equivalent to defsetf except that it calls make-symbol -;; whereas defsetf calls gensym (Using gensym creates a run-time -;; dependency on the CL library). - -(eval-and-compile - (define-setf-method gnus-agent-cat-groups (category) - (let* ((--category--temp-- (make-symbol "--category--")) - (--groups--temp-- (make-symbol "--groups--"))) - (list (list --category--temp--) - (list category) - (list --groups--temp--) - (let* ((category --category--temp--) - (groups --groups--temp--)) - (list (quote gnus-agent-set-cat-groups) category groups)) - (list (quote gnus-agent-cat-groups) --category--temp--)))) - ) +;; This form may expand to code that uses CL functions at run-time, +;; but that's OK since those functions will only ever be called from +;; something like `setf', so only when CL is loaded anyway. +(defsetf gnus-agent-cat-groups gnus-agent-set-cat-groups) (defun gnus-agent-set-cat-groups (category groups) (unless (eq groups 'ignore) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index bb374fba11b..b9020a40b75 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -2437,9 +2437,10 @@ long lines if and only if arg is positive." (apply 'gnus-create-image png 'png t (cdr (assq 'png gnus-face-properties-alist)))) (goto-char from) - (gnus-add-wash-type 'face) - (gnus-add-image 'face image) - (gnus-put-image image nil 'face)))))))))) + (when image + (gnus-add-wash-type 'face) + (gnus-add-image 'face image) + (gnus-put-image image nil 'face))))))))))) (defun article-display-x-face (&optional force) "Look for an X-Face header and display it if present." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index bcd2cd438e9..594f68bb86f 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -174,7 +174,7 @@ specifies a group to which resent messages will be Gcc'd. If this is nil, Gcc will be done according to existing Gcc header(s), if any. If this is `no-gcc-self', resent messages will be Gcc'd to groups that existing Gcc header specifies, except for the current group." - :version "24.2" + :version "24.3" :group 'gnus-message :type '(choice (const none) (const t) string (const nil) (const no-gcc-self))) diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 3b335b335dd..44f56b5acf3 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -78,7 +78,7 @@ Some people may want to add \"unknown\" to this list." (defcustom gnus-picon-properties '(:color-symbols (("None" . "white"))) "List of image properties applied to picons." :type 'list - :version "24.2" + :version "24.3" :group 'gnus-picon) (defcustom gnus-picon-style 'inline diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 939d56bbfd8..8fd89b1742c 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -1336,7 +1336,7 @@ If nil, you might be asked to input the charset." "*Addresses to prune when doing wide replies. This can be a regexp or a list of regexps. Also, a value of nil means exclude your own user name only." - :version "24.2" + :version "24.3" :group 'message :link '(custom-manual "(message)Wide Reply") :type '(choice (const :tag "Yourself" nil) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 1645f49091f..93f04cda929 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -559,7 +559,7 @@ parameter. It should return nil, `warn' or `delete'." "Extra headers to parse. In addition to the standard headers, these extra headers will be included in NOV headers (and the like) when backends parse headers." - :version "24.2" + :version "24.3" :group 'nnmail :type '(repeat symbol)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index f585bff871f..4b1480444c2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -380,26 +380,125 @@ suitable file is found, return nil." (declare-function ad-get-advice-info "advice" (function)) +(defun help-fns--key-bindings (function) + (when (commandp function) + (let ((pt2 (with-current-buffer standard-output (point))) + (remapped (command-remapping function))) + (unless (memq remapped '(ignore undefined)) + (let ((keys (where-is-internal + (or remapped function) overriding-local-map nil nil)) + non-modified-keys) + (if (and (eq function 'self-insert-command) + (vectorp (car-safe keys)) + (consp (aref (car keys) 0))) + (princ "It is bound to many ordinary text characters.\n") + ;; Which non-control non-meta keys run this command? + (dolist (key keys) + (if (member (event-modifiers (aref key 0)) '(nil (shift))) + (push key non-modified-keys))) + (when remapped + (princ "Its keys are remapped to `") + (princ (symbol-name remapped)) + (princ "'.\n")) + + (when keys + (princ (if remapped + "Without this remapping, it would be bound to " + "It is bound to ")) + ;; If lots of ordinary text characters run this command, + ;; don't mention them one by one. + (if (< (length non-modified-keys) 10) + (princ (mapconcat 'key-description keys ", ")) + (dolist (key non-modified-keys) + (setq keys (delq key keys))) + (if keys + (progn + (princ (mapconcat 'key-description keys ", ")) + (princ ", and many ordinary text characters")) + (princ "many ordinary text characters")))) + (when (or remapped keys non-modified-keys) + (princ ".") + (terpri))))) + + (with-current-buffer standard-output + (fill-region-as-paragraph pt2 (point)) + (unless (looking-back "\n\n") + (terpri)))))) + (defun help-fns--compiler-macro (function) - (let ((handler nil)) - ;; FIXME: Copied from macroexp.el. - (while (and (symbolp function) - (not (setq handler (get function 'compiler-macro))) - (fboundp function)) - ;; Follow the sequence of aliases. - (setq function (symbol-function function))) + (let ((handler (function-get function 'compiler-macro))) (when handler - (princ "This function has a compiler macro") + (insert "\nThis function has a compiler macro") (let ((lib (get function 'compiler-macro-file))) ;; FIXME: rather than look at the compiler-macro-file property, ;; just look at `handler' itself. (when (stringp lib) - (princ (format " in `%s'" lib)) - (with-current-buffer standard-output - (save-excursion - (re-search-backward "`\\([^`']+\\)'" nil t) - (help-xref-button 1 'help-function-cmacro function lib))))) - (princ ".\n\n")))) + (insert (format " in `%s'" lib)) + (save-excursion + (re-search-backward "`\\([^`']+\\)'" nil t) + (help-xref-button 1 'help-function-cmacro function lib)))) + (insert ".\n")))) + +(defun help-fns--signature (function doc real-def real-function) + (unless (keymapp function) ; If definition is a keymap, skip arglist note. + (let* ((advertised (gethash real-def advertised-signature-table t)) + (arglist (if (listp advertised) + advertised (help-function-arglist real-def))) + (usage (help-split-fundoc doc function))) + (if usage (setq doc (cdr usage))) + (let* ((use (cond + ((and usage (not (listp advertised))) (car usage)) + ((listp arglist) + (format "%S" (help-make-usage function arglist))) + ((stringp arglist) arglist) + ;; Maybe the arglist is in the docstring of a symbol + ;; this one is aliased to. + ((let ((fun real-function)) + (while (and (symbolp fun) + (setq fun (symbol-function fun)) + (not (setq usage (help-split-fundoc + (documentation fun) + function))))) + usage) + (car usage)) + ((or (stringp real-def) + (vectorp real-def)) + (format "\nMacro: %s" (format-kbd-macro real-def))) + (t "[Missing arglist. Please make a bug report.]"))) + (high (help-highlight-arguments use doc))) + (let ((fill-begin (point))) + (insert (car high) "\n") + (fill-region fill-begin (point))) + (cdr high))))) + +(defun help-fns--parent-mode (function) + ;; If this is a derived mode, link to the parent. + (let ((parent-mode (and (symbolp function) + (get function + 'derived-mode-parent)))) + (when parent-mode + (insert "\nParent mode: `") + (let ((beg (point))) + (insert (format "%s" parent-mode)) + (make-text-button beg (point) + 'type 'help-function + 'help-args (list parent-mode))) + (insert "'.\n")))) + +(defun help-fns--obsolete (function) + (let* ((obsolete (and + ;; `function' might be a lambda construct. + (symbolp function) + (get function 'byte-obsolete-info))) + (use (car obsolete))) + (when obsolete + (insert "\nThis function is obsolete") + (when (nth 2 obsolete) + (insert (format " since %s" (nth 2 obsolete)))) + (insert (cond ((stringp use) (concat ";\n" use)) + (use (format ";\nuse `%s' instead." use)) + (t ".")) + "\n")))) ;; We could use `symbol-file' but this is a wee bit more efficient. (defun help-fns--autoloaded-p (function file) @@ -510,54 +609,8 @@ FILE is the file where FUNCTION was probably defined." (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point)) (point))) (terpri)(terpri) - (when (commandp function) - (let ((pt2 (with-current-buffer (help-buffer) (point))) - (remapped (command-remapping function))) - (unless (memq remapped '(ignore undefined)) - (let ((keys (where-is-internal - (or remapped function) overriding-local-map nil nil)) - non-modified-keys) - (if (and (eq function 'self-insert-command) - (vectorp (car-safe keys)) - (consp (aref (car keys) 0))) - (princ "It is bound to many ordinary text characters.\n") - ;; Which non-control non-meta keys run this command? - (dolist (key keys) - (if (member (event-modifiers (aref key 0)) '(nil (shift))) - (push key non-modified-keys))) - (when remapped - (princ "Its keys are remapped to `") - (princ (symbol-name remapped)) - (princ "'.\n")) - - (when keys - (princ (if remapped - "Without this remapping, it would be bound to " - "It is bound to ")) - ;; If lots of ordinary text characters run this command, - ;; don't mention them one by one. - (if (< (length non-modified-keys) 10) - (princ (mapconcat 'key-description keys ", ")) - (dolist (key non-modified-keys) - (setq keys (delq key keys))) - (if keys - (progn - (princ (mapconcat 'key-description keys ", ")) - (princ ", and many ordinary text characters")) - (princ "many ordinary text characters")))) - (when (or remapped keys non-modified-keys) - (princ ".") - (terpri))))) - - (with-current-buffer (help-buffer) - (fill-region-as-paragraph pt2 (point)) - (unless (looking-back "\n\n") - (terpri))))) - (help-fns--compiler-macro function) - (let* ((advertised (gethash real-def advertised-signature-table t)) - (arglist (if (listp advertised) - advertised (help-function-arglist real-def))) - (doc-raw (condition-case err + + (let* ((doc-raw (condition-case err (documentation function t) (error (format "No Doc! %S" err)))) ;; If the function is autoloaded, and its docstring has @@ -568,66 +621,18 @@ FILE is the file where FUNCTION was probably defined." (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) (load (cadr real-def) t)) - (substitute-command-keys doc-raw))) - (usage (help-split-fundoc doc function))) - (with-current-buffer standard-output - ;; If definition is a keymap, skip arglist note. - (unless (keymapp function) - (if usage (setq doc (cdr usage))) - (let* ((use (cond - ((and usage (not (listp advertised))) (car usage)) - ((listp arglist) - (format "%S" (help-make-usage function arglist))) - ((stringp arglist) arglist) - ;; Maybe the arglist is in the docstring of a symbol - ;; this one is aliased to. - ((let ((fun real-function)) - (while (and (symbolp fun) - (setq fun (symbol-function fun)) - (not (setq usage (help-split-fundoc - (documentation fun) - function))))) - usage) - (car usage)) - ((or (stringp real-def) - (vectorp real-def)) - (format "\nMacro: %s" (format-kbd-macro real-def))) - (t "[Missing arglist. Please make a bug report.]"))) - (high (help-highlight-arguments use doc))) - (let ((fill-begin (point))) - (insert (car high) "\n") - (fill-region fill-begin (point))) - (setq doc (cdr high)))) + (substitute-command-keys doc-raw)))) - ;; If this is a derived mode, link to the parent. - (let ((parent-mode (and (symbolp real-function) - (get real-function - 'derived-mode-parent)))) - (when parent-mode - (with-current-buffer standard-output - (insert "\nParent mode: `") - (let ((beg (point))) - (insert (format "%s" parent-mode)) - (make-text-button beg (point) - 'type 'help-function - 'help-args (list parent-mode)))) - (princ "'.\n"))) + (help-fns--key-bindings function) + (with-current-buffer standard-output + (setq doc (help-fns--signature function doc real-def real-function)) - (let* ((obsolete (and - ;; function might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info))) - (use (car obsolete))) - (when obsolete - (princ "\nThis function is obsolete") - (when (nth 2 obsolete) - (insert (format " since %s" (nth 2 obsolete)))) - (insert (cond ((stringp use) (concat ";\n" use)) - (use (format ";\nuse `%s' instead." use)) - (t ".")) - "\n")) - (insert "\n" - (or doc "Not documented.")))))))) + (help-fns--compiler-macro function) + (help-fns--parent-mode function) + (help-fns--obsolete function) + + (insert "\n" + (or doc "Not documented."))))))) ;; Variables @@ -713,6 +718,7 @@ it is displayed along with the global value." (message "You did not specify a variable") (save-excursion (let ((valvoid (not (with-current-buffer buffer (boundp variable)))) + (permanent-local (get variable 'permanent-local)) val val-start-pos locus) ;; Extract the value before setting up the output buffer, ;; in case `buffer' *is* the output buffer. @@ -752,7 +758,6 @@ it is displayed along with the global value." (princ "value is ") (let ((from (point)) (line-beg (line-beginning-position)) - ;; (print-rep (let ((print-quoted t)) (prin1-to-string val)))) @@ -780,9 +785,7 @@ it is displayed along with the global value." (when locus (cond ((bufferp locus) - (princ (format "%socal in buffer %s; " - (if (get variable 'permanent-local) - "Permanently l" "L") + (princ (format "Local in buffer %s; " (buffer-name)))) ((framep locus) (princ (format "It is a frame-local variable; "))) @@ -792,20 +795,22 @@ it is displayed along with the global value." (princ (format "It is local to %S" locus)))) (if (not (default-boundp variable)) (princ "globally void") - (let ((val (default-value variable))) + (let ((global-val (default-value variable))) (with-current-buffer standard-output (princ "global value is ") - (terpri) - ;; Fixme: pp can take an age if you happen to - ;; ask for a very large expression. We should - ;; probably print it raw once and check it's a - ;; sensible size before prettyprinting. -- fx - (let ((from (point))) - (pp val) - ;; See previous comment for this function. - ;; (help-xref-on-pp from (point)) - (if (< (point) (+ from 20)) - (delete-region (1- from) from)))))) + (if (eq val global-val) + (princ "the same.") + (terpri) + ;; Fixme: pp can take an age if you happen to + ;; ask for a very large expression. We should + ;; probably print it raw once and check it's a + ;; sensible size before prettyprinting. -- fx + (let ((from (point))) + (pp global-val) + ;; See previous comment for this function. + ;; (help-xref-on-pp from (point)) + (if (< (point) (+ from 20)) + (delete-region (1- from) from))))))) (terpri)) ;; If the value is large, move it to the end. @@ -846,18 +851,26 @@ it is displayed along with the global value." alias 'variable-documentation)) (error (format "Doc not found: %S" err)))) (extra-line nil)) - ;; Add a note for variables that have been make-var-buffer-local. - (when (and (local-variable-if-set-p variable) - (or (not (local-variable-p variable)) - (with-temp-buffer - (local-variable-if-set-p variable)))) + + ;; Mention if it's a local variable. + (cond + ((and (local-variable-if-set-p variable) + (or (not (local-variable-p variable)) + (with-temp-buffer + (local-variable-if-set-p variable)))) (setq extra-line t) (princ " Automatically becomes ") - (if (get variable 'permanent-local) + (if permanent-local (princ "permanently ")) (princ "buffer-local when set.\n")) + ((not permanent-local)) + ((bufferp locus) + (princ " This variable's buffer-local value is permanent.\n")) + (t + (princ " This variable's value is permanent \ +if it is given a local binding.\n"))) - ;; Mention if it's an alias + ;; Mention if it's an alias. (unless (eq alias variable) (setq extra-line t) (princ (format " This variable is an alias for `%s'.\n" alias))) @@ -879,9 +892,11 @@ it is displayed along with the global value." (not (file-remote-p (buffer-file-name))) (dir-locals-find-file (buffer-file-name)))) - (type "file")) - (princ " This variable is a directory local variable") - (when file + (dir-file t)) + (princ " This variable's value is directory-local") + (if (null file) + (princ ".\n") + (princ ", set ") (if (consp file) ; result from cache ;; If the cache element has an mtime, we ;; assume it came from a file. @@ -889,21 +904,27 @@ it is displayed along with the global value." (setq file (expand-file-name dir-locals-file (car file))) ;; Otherwise, assume it was set directly. - (setq type "directory"))) - (princ (format "\n from the %s \"%s\"" type file))) - (princ ".\n")) - (princ " This variable is a file local variable.\n"))) + (setq dir-file nil))) + (princ (if dir-file + "by the file\n `" + "for the directory\n `")) + (with-current-buffer standard-output + (insert-text-button + file 'type 'help-dir-local-var-def + 'help-args (list variable file))) + (princ "'.\n"))) + (princ " This variable's value is file-local.\n"))) (when (memq variable ignored-local-variables) (setq extra-line t) - (princ " This variable is ignored when used as a file local \ + (princ " This variable is ignored as a file-local \ variable.\n")) ;; Can be both risky and safe, eg auto-fill-function. (when (risky-local-variable-p variable) (setq extra-line t) - (princ " This variable is potentially risky when used as a \ -file local variable.\n") + (princ " This variable may be risky if used as a \ +file-local variable.\n") (when (assq variable safe-local-variable-values) (princ " However, you have added it to \ `safe-local-variable-values'.\n"))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7b6490b6b13..9924300647c 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -265,6 +265,15 @@ The format is (FUNCTION ARGS...).") :supertype 'help-xref 'help-function 'customize-create-theme 'help-echo (purecopy "mouse-2, RET: edit this theme file")) + +(define-button-type 'help-dir-local-var-def + :supertype 'help-xref + 'help-function (lambda (var &optional file) + ;; FIXME: this should go to the point where the + ;; local variable was defined. + (find-file file)) + 'help-echo (purecopy "mouse-2, RET: open directory-local variables file")) + (defvar bookmark-make-record-function) diff --git a/lisp/help.el b/lisp/help.el index c02b058fef9..19cb811bcf5 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1038,7 +1038,7 @@ construct (see `substitute-command-keys'), the library is loaded, so that the documentation can show the right key bindings." :type 'boolean :group 'help - :version "24.2") + :version "24.3") (defun help-window-display-message (quit-part window &optional scroll) "Display message telling how to quit and scroll help window. diff --git a/lisp/hexl.el b/lisp/hexl.el index 75094cd33b8..7dd39807955 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -58,7 +58,7 @@ (const 32) (const 64)) :group 'hexl - :version "24.2") + :version "24.3") (defcustom hexl-program "hexl" "The program that will hexlify and dehexlify its stdin. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 2c2d08e19cc..644024a4b86 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -287,12 +287,19 @@ With a prefix argument ARG, enable Hi Lock mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Issuing one the highlighting commands listed below will -automatically enable Hi Lock mode. To enable Hi Lock mode in all -buffers, use `global-hi-lock-mode' or add (global-hi-lock-mode 1) -to your init file. When Hi Lock mode is enabled, a \"Regexp -Highlighting\" submenu is added to the \"Edit\" menu. The -commands in the submenu, which can be called interactively, are: +Hi Lock mode is automatically enabled when you invoke any of the +highlighting commands listed below, such as \\[highlight-regexp]. +To enable Hi Lock mode in all buffers, use `global-hi-lock-mode' +or add (global-hi-lock-mode 1) to your init file. + +In buffers where Font Lock mode is enabled, patterns are +highlighted using font lock. In buffers where Font Lock mode is +disabled, patterns are applied using overlays; in this case, the +highlighting will not be updated as you type. + +When Hi Lock mode is enabled, a \"Regexp Highlighting\" submenu +is added to the \"Edit\" menu. The commands in the submenu, +which can be called interactively, are: \\[highlight-regexp] REGEXP FACE Highlight matches of pattern REGEXP in current buffer with FACE. @@ -326,12 +333,12 @@ When hi-lock is started and if the mode is not excluded or patterns rejected, the beginning of the buffer is searched for lines of the form: Hi-lock: FOO -where FOO is a list of patterns. These are added to the font lock -keywords already present. The patterns must start before position -\(number of characters into buffer) `hi-lock-file-patterns-range'. -Patterns will be read until - Hi-lock: end -is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." + +where FOO is a list of patterns. The patterns must start before +position \(number of characters into buffer) +`hi-lock-file-patterns-range'. Patterns will be read until +Hi-lock: end is found. A mode is excluded if it's in the list +`hi-lock-exclude-modes'." :group 'hi-lock :lighter (:eval (if (or hi-lock-interactive-patterns hi-lock-file-patterns) @@ -358,7 +365,6 @@ versions before 22 use the following in your .emacs file: (if hi-lock-mode ;; Turned on. (progn - (unless font-lock-mode (font-lock-mode 1)) (define-key-after menu-bar-edit-menu [hi-lock] (cons "Regexp Highlighting" hi-lock-menu)) (hi-lock-find-patterns) @@ -392,12 +398,13 @@ versions before 22 use the following in your .emacs file: ;;;###autoload (defun hi-lock-line-face-buffer (regexp &optional face) "Set face of all lines containing a match of REGEXP to FACE. +Interactively, prompt for REGEXP then FACE, using a buffer-local +history list for REGEXP and a global history list for FACE. -Interactively, prompt for REGEXP then FACE. Buffer-local history -list maintained for regexps, global history maintained for faces. -\\Use \\[previous-history-element] to retrieve previous history items, -and \\[next-history-element] to retrieve default values. -\(See info node `Minibuffer History'.)" +If Font Lock mode is enabled in the buffer, it is used to +highlight REGEXP. If Font Lock mode is disabled, overlays are +used for highlighting; in this case, the highlighting will not be +updated as you type." (interactive (list (hi-lock-regexp-okay @@ -416,12 +423,13 @@ and \\[next-history-element] to retrieve default values. ;;;###autoload (defun hi-lock-face-buffer (regexp &optional face) "Set face of each match of REGEXP to FACE. +Interactively, prompt for REGEXP then FACE, using a buffer-local +history list for REGEXP and a global history list for FACE. -Interactively, prompt for REGEXP then FACE. Buffer-local history -list maintained for regexps, global history maintained for faces. -\\Use \\[previous-history-element] to retrieve previous history items, -and \\[next-history-element] to retrieve default values. -\(See info node `Minibuffer History'.)" +If Font Lock mode is enabled in the buffer, it is used to +highlight REGEXP. If Font Lock mode is disabled, overlays are +used for highlighting; in this case, the highlighting will not be +updated as you type." (interactive (list (hi-lock-regexp-okay @@ -436,9 +444,13 @@ and \\[next-history-element] to retrieve default values. ;;;###autoload (defun hi-lock-face-phrase-buffer (regexp &optional face) "Set face of each match of phrase REGEXP to FACE. - Whitespace in REGEXP converted to arbitrary whitespace and initial -lower-case letters made case insensitive." +lower-case letters made case insensitive. + +If Font Lock mode is enabled in the buffer, it is used to +highlight REGEXP. If Font Lock mode is disabled, overlays are +used for highlighting; in this case, the highlighting will not be +updated as you type." (interactive (list (hi-lock-regexp-okay @@ -456,12 +468,8 @@ lower-case letters made case insensitive." ;;;###autoload (defun hi-lock-unface-buffer (regexp) "Remove highlighting of each match to REGEXP set by hi-lock. - -Interactively, prompt for REGEXP. Buffer-local history of inserted -regexp's maintained. Will accept only regexps inserted by hi-lock -interactive functions. \(See `hi-lock-interactive-patterns'.\) -\\Use \\[minibuffer-complete] to complete a partially typed regexp. -\(See info node `Minibuffer History'.\)" +Interactively, prompt for REGEXP, accepting only regexps +previously inserted by hi-lock interactive functions." (interactive (if (and (display-popup-menus-p) (listp last-nonmenu-event) @@ -573,7 +581,7 @@ not suitable." (let ((pattern (list regexp (list 0 (list 'quote face) t)))) (unless (member pattern hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) - (if font-lock-fontified + (if font-lock-mode (progn (font-lock-add-keywords nil (list pattern) t) (font-lock-fontify-buffer)) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index d29653c41ae..648c4c3b0af 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1279,11 +1279,11 @@ a new window in the current frame, splitting vertically." (define-ibuffer-op ibuffer-do-toggle-read-only (&optional arg) "Toggle read only status in marked buffers. -With optional ARG, make read-only only if ARG is positive." +With optional ARG, make read-only only if ARG is not negative." (:opstring "toggled read only status in" :interactive "P" :modifier-p t) - (toggle-read-only arg t)) + (call-interactively 'toggle-read-only)) (define-ibuffer-op ibuffer-do-delete () "Kill marked buffers as with `kill-this-buffer'." diff --git a/lisp/image.el b/lisp/image.el index f5a2de5e595..7801923c3fe 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -774,7 +774,7 @@ has no effect." :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.2" + :version "24.3" :group 'image) (defcustom imagemagick-enabled-types @@ -812,7 +812,7 @@ has no effect." :set (lambda (symbol value) (set-default symbol value) (imagemagick-register-types)) - :version "24.2" + :version "24.3" :group 'image) (imagemagick-register-types) diff --git a/lisp/imenu.el b/lisp/imenu.el index 8cef5161a37..c2a80d69675 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -187,16 +187,39 @@ with name concatenation." ;;;###autoload (defvar imenu-generic-expression nil - "The regex pattern to use for creating a buffer index. + "List of definition matchers for creating an Imenu index. +Each element of this list should have the form + + (MENU-TITLE REGEXP INDEX [FUNCTION] [ARGUMENTS...]) + +MENU-TITLE should be nil (in which case the matches for this +element are put in the top level of the buffer index) or a +string (which specifies the title of a submenu into which the +matches are put). +REGEXP is a regular expression matching a definition construct +which is to be displayed in the menu. REGEXP may also be a +function, called without arguments. It is expected to search +backwards. It must return true and set `match-data' if it finds +another element. +INDEX is an integer specifying which subexpression of REGEXP +matches the definition's name; this subexpression is displayed as +the menu item. +FUNCTION, if present, specifies a function to call when the index +item is selected by the user. This function is called with +arguments consisting of the item name, the buffer position, and +the ARGUMENTS. + +The variable `imenu-case-fold-search' determines whether or not +the regexp matches are case sensitive, and `imenu-syntax-alist' +can be used to alter the syntax table for the search. If non-nil this pattern is passed to `imenu--generic-function' to -create a buffer index. Look there for the documentation of this -pattern's structure. +create a buffer index. -For example, see the value of `fortran-imenu-generic-expression' used by -`fortran-mode' with `imenu-syntax-alist' set locally to give the -characters which normally have \"symbol\" syntax \"word\" syntax -during matching.") +For example, see the value of `fortran-imenu-generic-expression' +used by `fortran-mode' with `imenu-syntax-alist' set locally to +give the characters which normally have \"symbol\" syntax +\"word\" syntax during matching.") ;;;###autoload(put 'imenu-generic-expression 'risky-local-variable t) ;;;###autoload @@ -694,46 +717,16 @@ for modes which use `imenu--generic-function'. If it is not set, but ;; so it needs to be careful never to loop! (defun imenu--generic-function (patterns) "Return an index alist of the current buffer based on PATTERNS. +PATTERNS should be an alist which has the same form as +`imenu-generic-expression'. -PATTERNS is an alist with elements that look like this: - (MENU-TITLE REGEXP INDEX) -or like this: - (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) -with zero or more ARGUMENTS. The former format creates a simple -element in the index alist when it matches; the latter creates a -special element of the form (INDEX-NAME POSITION-MARKER FUNCTION -ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS. - -MENU-TITLE is a string used as the title for the submenu or nil -if the entries are not nested. - -REGEXP is a regexp that should match a construct in the buffer -that is to be displayed in the menu; i.e., function or variable -definitions, etc. It contains a substring which is the name to -appear in the menu. See the info section on Regexps for more -information. REGEXP may also be a function, called without -arguments. It is expected to search backwards. It shall return -true and set `match-data' if it finds another element. - -INDEX points to the substring in REGEXP that contains the -name (of the function, variable or type) that is to appear in the -menu. - -The variable `imenu-case-fold-search' determines whether or not the -regexp matches are case sensitive, and `imenu-syntax-alist' can be -used to alter the syntax table for the search. - -See `lisp-imenu-generic-expression' for an example of PATTERNS. - -Returns an index of the current buffer as an alist. The elements in -the alist look like: +The return value is an alist of the form (INDEX-NAME . INDEX-POSITION) -or like: +or (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...) -They may also be nested index alists like: +The return value may also consist of nested index alists like: (INDEX-NAME . INDEX-ALIST) depending on PATTERNS." - (let ((index-alist (list 'dummy)) (case-fold-search (if (or (local-variable-p 'imenu-case-fold-search) (not (local-variable-p 'font-lock-defaults))) diff --git a/lisp/info.el b/lisp/info.el index 163e0af161a..317cba86500 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -342,12 +342,12 @@ a tab, a carriage return (control-M), a newline, and `]+'." (defcustom Info-isearch-search t "If non-nil, isearch in Info searches through multiple nodes. Before leaving the initial Info node, where isearch was started, -it fails once with the error message [initial node], and with +it fails once with the error message [end of node], and with subsequent C-s/C-r continues through other nodes without failing with this error message in other nodes. When isearch fails for -the rest of the manual, it wraps around the whole manual and -restarts the search from the top/final node depending on -search direction. +the rest of the manual, it displays the error message [end of manual], +wraps around the whole manual and restarts the search from the top/final +node depending on search direction. Setting this option to nil restores the default isearch behavior with wrapping around the current Info node." @@ -1863,7 +1863,7 @@ If DIRECTION is `backward', search in the reverse direction." (not bound) (or give-up (and found (not (and (> found opoint-min) (< found opoint-max)))))) - (signal 'search-failed (list regexp "initial node"))) + (signal 'search-failed (list regexp "end of node"))) ;; If no subfiles, give error now. (if give-up @@ -2006,7 +2006,7 @@ If DIRECTION is `backward', search in the reverse direction." ;; Lax version of word search (let ((lax (not (or isearch-nonincremental (eq (length string) - (length (isearch-string-state + (length (isearch--state-string (car isearch-cmds)))))))) (if (functionp isearch-word) (funcall isearch-word string lax) @@ -2854,7 +2854,7 @@ N is the digit argument used to invoke this command." (Info-extract-menu-node-name))))) (defmacro Info-no-error (&rest body) - (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil))) + `(condition-case nil (progn ,@body t) (error nil))) (defun Info-next-preorder () "Go to the next subnode or the next node, or go up a level." @@ -5020,11 +5020,18 @@ BUFFER is the buffer speedbar is requesting buttons for." (defun Info-bookmark-make-record () "This implements the `bookmark-make-record-function' type (which see) for Info nodes." - `(,Info-current-node - ,@(bookmark-make-record-default 'no-file) - (filename . ,Info-current-file) - (info-node . ,Info-current-node) - (handler . Info-bookmark-jump))) + (let* ((file (and (stringp Info-current-file) + (file-name-nondirectory Info-current-file))) + (bookmark-name (if file + (concat "(" file ") " Info-current-node) + Info-current-node)) + (defaults (delq nil (list bookmark-name file Info-current-node)))) + `(,bookmark-name + ,@(bookmark-make-record-default 'no-file) + (filename . ,Info-current-file) + (info-node . ,Info-current-node) + (handler . Info-bookmark-jump) + (defaults . ,defaults)))) ;;;###autoload (defun Info-bookmark-jump (bmk) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a6ea2c1796c..2fc9759972e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1331,6 +1331,9 @@ of `history-length', which see.") (make-variable-buffer-local 'input-method-history) (put 'input-method-history 'permanent-local t) +(define-obsolete-variable-alias + 'inactivate-current-input-method-function + 'deactivate-current-input-method-function "24.3") (defvar deactivate-current-input-method-function nil "Function to call for deactivating the current input method. Every input method should set this to an appropriate value when activated. @@ -1470,7 +1473,7 @@ If INPUT-METHOD is nil, deactivate any current input method." (define-obsolete-function-alias 'inactivate-input-method - 'deactivate-input-method "24.2") + 'deactivate-input-method "24.3") (defun set-input-method (input-method &optional interactive) "Select and activate input method INPUT-METHOD for the current buffer. @@ -1648,7 +1651,7 @@ just activated." (define-obsolete-variable-alias 'input-method-inactivate-hook - 'input-method-deactivate-hook "24.2") + 'input-method-deactivate-hook "24.3") (defcustom input-method-deactivate-hook nil "Normal hook run just after an input method is deactivated. @@ -1657,7 +1660,7 @@ The variable `current-input-method' still keeps the input method name just deactivated." :type 'hook :group 'mule - :version "24.2") + :version "24.3") (defcustom input-method-after-insert-chunk-hook nil "Normal hook run just after an input method insert some chunk of text." @@ -2956,7 +2959,7 @@ point or a number in hash notation, e.g. #o21430 for octal, (t (cdr (assoc-string input (ucs-names) t)))))) -(define-obsolete-function-alias 'ucs-insert 'insert-char "24.2") +(define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) ;;; mule-cmds.el ends here diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 65ef807c238..4669528c9a7 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -547,7 +547,7 @@ This function runs the normal hook `quail-deactivate-hook'." (interactive) (quail-activate -1)) -(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.2") +(define-obsolete-function-alias 'quail-inactivate 'quail-deactivate "24.3") (defun quail-activate (&optional arg) "Activate Quail input method. @@ -595,7 +595,7 @@ While this input method is active, the variable (define-obsolete-variable-alias 'quail-inactivate-hook - 'quail-deactivate-hook "24.2") + 'quail-deactivate-hook "24.3") (defun quail-exit-from-minibuffer () (deactivate-input-method) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index fee4c330e6e..897075f0faf 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -396,7 +396,7 @@ A nil value means no package is selected.") (interactive) (robin-activate -1)) -(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.2") +(define-obsolete-function-alias 'robin-inactivate 'robin-deactivate "24.3") (defun robin-activate (&optional arg) "Activate robin input method. @@ -431,7 +431,7 @@ While this input method is active, the variable (define-obsolete-variable-alias 'robin-inactivate-hook - 'robin-deactivate-hook "24.2") + 'robin-deactivate-hook "24.3") (defun robin-exit-from-minibuffer () (deactivate-input-method) diff --git a/lisp/isearch.el b/lisp/isearch.el index 27185bf3fa6..9271ce32484 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -57,6 +57,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) ;; Some additional options and constants. @@ -413,13 +414,6 @@ This is like `describe-bindings', but displays only Isearch keys." ;; Make function keys, etc, which aren't bound to a scrolling-function ;; exit the search. (define-key map [t] 'isearch-other-control-char) - ;; Control chars, by default, end isearch mode transparently. - ;; We need these explicit definitions because, in a dense keymap, - ;; the binding for t does not affect characters. - ;; We use a dense keymap to save space. - (while (< i ?\s) - (define-key map (make-string 1 i) 'isearch-other-control-char) - (setq i (1+ i))) ;; Single-byte printing chars extend the search string by default. (setq i ?\s) @@ -434,8 +428,8 @@ This is like `describe-bindings', but displays only Isearch keys." ;; default local key binding for any key not otherwise bound. (let ((meta-map (make-sparse-keymap))) (define-key map (char-to-string meta-prefix-char) meta-map) - (define-key map [escape] meta-map)) - (define-key map (vector meta-prefix-char t) 'isearch-other-meta-char) + (define-key map [escape] meta-map) + (define-key meta-map [t] 'isearch-other-meta-char)) ;; Several non-printing chars change the searching behavior. (define-key map "\C-s" 'isearch-repeat-forward) @@ -965,9 +959,10 @@ NOPUSH is t and EDIT is t." (before (if (bobp) nil (get-text-property (1- (point)) 'intangible)))) (when (and before after (eq before after)) - (if isearch-forward - (goto-char (next-single-property-change (point) 'intangible)) - (goto-char (previous-single-property-change (point) 'intangible))))) + (goto-char + (if isearch-forward + (next-single-property-change (point) 'intangible) + (previous-single-property-change (point) 'intangible))))) (if (and (> (length isearch-string) 0) (not nopush)) ;; Update the ring data. @@ -1007,73 +1002,58 @@ REGEXP if non-nil says use the regexp search ring." ;; The search status structure and stack. -(defsubst isearch-string-state (frame) - "Return the search string in FRAME." - (aref frame 0)) -(defsubst isearch-message-state (frame) - "Return the search string to display to the user in FRAME." - (aref frame 1)) -(defsubst isearch-point-state (frame) - "Return the point in FRAME." - (aref frame 2)) -(defsubst isearch-success-state (frame) - "Return the success flag in FRAME." - (aref frame 3)) -(defsubst isearch-forward-state (frame) - "Return the searching-forward flag in FRAME." - (aref frame 4)) -(defsubst isearch-other-end-state (frame) - "Return the other end of the match in FRAME." - (aref frame 5)) -(defsubst isearch-word-state (frame) - "Return the search-by-word flag in FRAME." - (aref frame 6)) -(defsubst isearch-error-state (frame) - "Return the regexp error message in FRAME, or nil if its regexp is valid." - (aref frame 7)) -(defsubst isearch-wrapped-state (frame) - "Return the search-wrapped flag in FRAME." - (aref frame 8)) -(defsubst isearch-barrier-state (frame) - "Return the barrier value in FRAME." - (aref frame 9)) -(defsubst isearch-case-fold-search-state (frame) - "Return the case-folding flag in FRAME." - (aref frame 10)) -(defsubst isearch-pop-fun-state (frame) - "Return the function restoring the mode-specific Isearch state in FRAME." - (aref frame 11)) +(cl-defstruct (isearch--state + (:constructor nil) + (:copier nil) + (:constructor isearch--get-state + (&aux + (string isearch-string) + (message isearch-message) + (point (point)) + (success isearch-success) + (forward isearch-forward) + (other-end isearch-other-end) + (word isearch-word) + (error isearch-error) + (wrapped isearch-wrapped) + (barrier isearch-barrier) + (case-fold-search isearch-case-fold-search) + (pop-fun (if isearch-push-state-function + (funcall isearch-push-state-function)))))) + (string :read-only t) + (message :read-only t) + (point :read-only t) + (success :read-only t) + (forward :read-only t) + (other-end :read-only t) + (word :read-only t) + (error :read-only t) + (wrapped :read-only t) + (barrier :read-only t) + (case-fold-search :read-only t) + (pop-fun :read-only t)) -(defun isearch-top-state () - (let ((cmd (car isearch-cmds))) - (setq isearch-string (isearch-string-state cmd) - isearch-message (isearch-message-state cmd) - isearch-success (isearch-success-state cmd) - isearch-forward (isearch-forward-state cmd) - isearch-other-end (isearch-other-end-state cmd) - isearch-word (isearch-word-state cmd) - isearch-error (isearch-error-state cmd) - isearch-wrapped (isearch-wrapped-state cmd) - isearch-barrier (isearch-barrier-state cmd) - isearch-case-fold-search (isearch-case-fold-search-state cmd)) - (if (functionp (isearch-pop-fun-state cmd)) - (funcall (isearch-pop-fun-state cmd) cmd)) - (goto-char (isearch-point-state cmd)))) +(defun isearch--set-state (cmd) + (setq isearch-string (isearch--state-string cmd) + isearch-message (isearch--state-message cmd) + isearch-success (isearch--state-success cmd) + isearch-forward (isearch--state-forward cmd) + isearch-other-end (isearch--state-other-end cmd) + isearch-word (isearch--state-word cmd) + isearch-error (isearch--state-error cmd) + isearch-wrapped (isearch--state-wrapped cmd) + isearch-barrier (isearch--state-barrier cmd) + isearch-case-fold-search (isearch--state-case-fold-search cmd)) + (if (functionp (isearch--state-pop-fun cmd)) + (funcall (isearch--state-pop-fun cmd) cmd)) + (goto-char (isearch--state-point cmd))) (defun isearch-pop-state () (setq isearch-cmds (cdr isearch-cmds)) - (isearch-top-state)) + (isearch--set-state (car isearch-cmds))) (defun isearch-push-state () - (setq isearch-cmds - (cons (vector isearch-string isearch-message (point) - isearch-success isearch-forward isearch-other-end - isearch-word - isearch-error isearch-wrapped isearch-barrier - isearch-case-fold-search - (if isearch-push-state-function - (funcall isearch-push-state-function))) - isearch-cmds))) + (push (isearch--get-state) isearch-cmds)) ;; Commands active while inside of the isearch minor mode. @@ -1100,11 +1080,11 @@ If MSG is non-nil, use `isearch-message', otherwise `isearch-string'." (curr-msg (if msg isearch-message isearch-string)) succ-msg) (when (or (not isearch-success) isearch-error) - (while (or (not (isearch-success-state (car cmds))) - (isearch-error-state (car cmds))) + (while (or (not (isearch--state-success (car cmds))) + (isearch--state-error (car cmds))) (pop cmds)) - (setq succ-msg (and cmds (if msg (isearch-message-state (car cmds)) - (isearch-string-state (car cmds))))) + (setq succ-msg (and cmds (if msg (isearch--state-message (car cmds)) + (isearch--state-string (car cmds))))) (if (and (stringp succ-msg) (< (length succ-msg) (length curr-msg)) (equal succ-msg @@ -1201,7 +1181,7 @@ The following additional command keys are active while editing. (minibuffer-history-symbol)) (setq isearch-new-string (read-from-minibuffer - (isearch-message-prefix nil nil isearch-nonincremental) + (isearch-message-prefix nil isearch-nonincremental) (cons isearch-string (1+ (or (isearch-fail-pos) (length isearch-string)))) minibuffer-local-isearch-map nil @@ -1294,18 +1274,18 @@ The following additional command keys are active while editing. ;; For defined push-state function, restore the first state. ;; This calls pop-state function and restores original point. (let ((isearch-cmds (last isearch-cmds))) - (isearch-top-state)) + (isearch--set-state (car isearch-cmds))) (goto-char isearch-opoint)) - (isearch-done t) ; exit isearch + (isearch-done t) ; Exit isearch.. (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (signal 'quit nil)) ; ..and pass on quit signal. (defun isearch-abort () "Abort incremental search mode if searching is successful, signaling quit. Otherwise, revert to previous successful search and continue searching. Use `isearch-exit' to quit without signaling." (interactive) -;; (ding) signal instead below, if quitting + ;; (ding) signal instead below, if quitting (discard-input) (if (and isearch-success (not isearch-error)) ;; If search is successful and has no incomplete regexp, @@ -1328,9 +1308,7 @@ Use `isearch-exit' to quit without signaling." (if (null (if isearch-regexp regexp-search-ring search-ring)) (setq isearch-error "No previous search string") (setq isearch-string - (if isearch-regexp - (car regexp-search-ring) - (car search-ring)) + (car (if isearch-regexp regexp-search-ring search-ring)) isearch-message (mapconcat 'isearch-text-char-description isearch-string "") @@ -1391,8 +1369,10 @@ Use `isearch-exit' to quit without signaling." (defun isearch-toggle-word () "Toggle word searching on or off." + ;; The status stack is left unchanged. (interactive) (setq isearch-word (not isearch-word)) + (if isearch-word (setq isearch-regexp nil)) (setq isearch-success t isearch-adjusted t) (isearch-update)) @@ -1411,7 +1391,7 @@ Use `isearch-exit' to quit without signaling." (if isearch-case-fold-search nil 'yes)) (let ((message-log-max nil)) (message "%s%s [case %ssensitive]" - (isearch-message-prefix nil nil isearch-nonincremental) + (isearch-message-prefix nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) (setq isearch-success t isearch-adjusted t) @@ -1857,7 +1837,7 @@ to the barrier." ;; We have to check 2 stack frames because the last might be ;; invalid just because of a backslash. (or (not isearch-error) - (not (isearch-error-state (cadr isearch-cmds))) + (not (isearch--state-error (cadr isearch-cmds))) allow-invalid)) (if to-barrier (progn (goto-char isearch-barrier) @@ -1872,8 +1852,8 @@ to the barrier." ;; Also skip over postfix operators -- though horrid, ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly valid. (while (and previous - (or (isearch-error-state frame) - (let* ((string (isearch-string-state frame)) + (or (isearch--state-error frame) + (let* ((string (isearch--state-string frame)) (lchar (aref string (1- (length string))))) ;; The operators aren't always operators; check ;; backslashes. This doesn't handle the case of @@ -1881,7 +1861,7 @@ to the barrier." ;; being special, but then we should fall back to ;; the barrier anyway because it's all optional. (if (isearch-backslash - (isearch-string-state (car previous))) + (isearch--state-string (car previous))) (eq lchar ?\}) (memq lchar '(?* ?? ?+)))))) (setq stack previous previous (cdr previous) frame (car stack))) @@ -1891,7 +1871,7 @@ to the barrier." ;; what matched before that. (let ((last-other-end (or (and (car previous) - (isearch-other-end-state (car previous))) + (isearch--state-other-end (car previous))) isearch-barrier))) (goto-char (if isearch-forward (max last-other-end isearch-barrier) @@ -2355,12 +2335,12 @@ If there is no completion possible, say so and continue searching." (add-text-properties (match-beginning 0) (match-end 0) '(face trailing-whitespace) m))) (setq m (concat - (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental) + (isearch-message-prefix ellipsis isearch-nonincremental) m - (isearch-message-suffix c-q-hack ellipsis))) + (isearch-message-suffix c-q-hack))) (if c-q-hack m (let ((message-log-max nil)) (message "%s" m))))) -(defun isearch-message-prefix (&optional _c-q-hack ellipsis nonincremental) +(defun isearch-message-prefix (&optional ellipsis nonincremental) ;; If about to search, and previous search regexp was invalid, ;; check that it still is. If it is valid now, ;; let the message we display while searching say that it is valid. @@ -2401,7 +2381,7 @@ If there is no completion possible, say so and continue searching." (propertize (concat (upcase (substring m 0 1)) (substring m 1)) 'face 'minibuffer-prompt))) -(defun isearch-message-suffix (&optional c-q-hack _ellipsis) +(defun isearch-message-suffix (&optional c-q-hack) (concat (if c-q-hack "^Q" "") (if isearch-error (concat " [" isearch-error "]") @@ -2435,7 +2415,8 @@ Can be changed via `isearch-search-fun-function' for special needs." ;; (or when using nonincremental word isearch) (let ((lax (not (or isearch-nonincremental (eq (length isearch-string) - (length (isearch-string-state (car isearch-cmds)))))))) + (length (isearch--state-string + (car isearch-cmds)))))))) (funcall (if isearch-forward #'re-search-forward #'re-search-backward) (if (functionp isearch-word) @@ -2501,6 +2482,7 @@ update the match data, and return point." (isearch-no-upper-case-p isearch-string isearch-regexp))) (condition-case lossage (let ((inhibit-point-motion-hooks + ;; FIXME: equality comparisons on functions is asking for trouble. (and (eq isearch-filter-predicate 'isearch-filter-visible) search-invisible)) (inhibit-quit nil) @@ -2545,11 +2527,12 @@ update the match data, and return point." (if isearch-success nil ;; Ding if failed this time after succeeding last time. - (and (isearch-success-state (car isearch-cmds)) + (and (isearch--state-success (car isearch-cmds)) (ding)) - (if (functionp (isearch-pop-fun-state (car isearch-cmds))) - (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds))) - (goto-char (isearch-point-state (car isearch-cmds))))) + (if (functionp (isearch--state-pop-fun (car isearch-cmds))) + (funcall (isearch--state-pop-fun (car isearch-cmds)) + (car isearch-cmds))) + (goto-char (isearch--state-point (car isearch-cmds))))) ;; Called when opening an overlay, and we are still in isearch. diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 1286b361892..ee06e34eef4 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -67,6 +67,14 @@ and Italian."))) (sample-text . "Arabic السّلام عليكم") (documentation . "Bidirectional editing is supported."))) +(set-language-info-alist + "Persian" '((charset unicode) + (coding-system utf-8 iso-8859-6 windows-1256) + (coding-priority utf-8 iso-8859-6 windows-1256) + (input-method . "farsi-transliterate-banan") + (sample-text . "Persian فارسی") + (documentation . "Bidirectional editing is supported."))) + (set-char-table-range composition-function-table '(#x600 . #x6FF) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 4afd974f49c..8b7a0ab3e6f 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -4133,7 +4133,7 @@ For example, the function `case' has an indent property ;;;;;; 653810 0)) ;;; Generated autoloads from emacs-lisp/cl-lib.el -(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.2") +(define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3") (defvar cl-custom-print-functions nil "\ This is a list of functions that format user objects for printing. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 8cc72e1afba..6ee3c7898c5 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -355,7 +355,7 @@ usually do not have translators for other languages.\n\n"))) (buffer-substring-no-properties (point-min) (point))) (goto-char user-point))) -(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.2") +(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3") ;; It's the default mail mode, so it seems OK to use its features. (autoload 'message-bogus-recipient-p "message") diff --git a/lisp/man.el b/lisp/man.el index 975aeb4db30..198cdbafab5 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -88,11 +88,9 @@ ;;; Code: +(require 'ansi-color) (require 'button) -;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -;; empty defvars (keep the compiler quiet) - (defgroup man nil "Browse UNIX manual pages." :prefix "Man-" @@ -100,6 +98,7 @@ :group 'help) (defvar Man-notify) + (defcustom Man-filter-list nil "Manpage cleaning filter command phrases. This variable contains a list of the following form: @@ -121,28 +120,34 @@ the manpage buffer." (defvar Man-sed-script nil "Script for sed to nuke backspaces and ANSI codes from manpages.") -;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -;; user variables - (defcustom Man-fontify-manpage-flag t "Non-nil means make up the manpage with fonts." :type 'boolean :group 'man) -(defcustom Man-overstrike-face 'bold +(defface Man-overstrike + '((t (:inherit bold))) "Face to use when fontifying overstrike." - :type 'face - :group 'man) + :group 'man + :version "24.3") -(defcustom Man-underline-face 'underline +(defface Man-underline + '((t (:inherit underline))) "Face to use when fontifying underlining." - :type 'face - :group 'man) + :group 'man + :version "24.3") -(defcustom Man-reverse-face 'highlight +(defface Man-reverse + '((t (:inherit highlight))) "Face to use when fontifying reverse video." - :type 'face - :group 'man) + :group 'man + :version "24.3") + +(defvar Man-ansi-color-map (let ((ansi-color-faces-vector + [ default Man-overstrike default Man-underline + Man-underline default default Man-reverse ])) + (ansi-color-make-color-map)) + "The value used here for `ansi-color-map'.") ;; Use the value of the obsolete user option Man-notify, if set. (defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) @@ -236,26 +241,40 @@ Used in `bookmark-set' to get the default bookmark name." :version "24.1" :type 'string :group 'bookmark) -(defvar manual-program "man" - "The name of the program that produces man pages.") +(defcustom manual-program "man" + "Program used by `man' to produce man pages." + :type 'string + :group 'man) -(defvar Man-untabify-command "pr" - "Command used for untabifying.") +(defcustom Man-untabify-command "pr" + "Program used by `man' for untabifying." + :type 'string + :group 'man) -(defvar Man-untabify-command-args (list "-t" "-e") - "List of arguments to be passed to `Man-untabify-command' (which see).") +(defcustom Man-untabify-command-args (list "-t" "-e") + "List of arguments to be passed to `Man-untabify-command' (which see)." + :type '(repeat string) + :group 'man) -(defvar Man-sed-command "sed" - "Command used for processing sed scripts.") +(defcustom Man-sed-command "sed" + "Program used by `man' to process sed scripts." + :type 'string + :group 'man) -(defvar Man-awk-command "awk" - "Command used for processing awk scripts.") +(defcustom Man-awk-command "awk" + "Program used by `man' to process awk scripts." + :type 'string + :group 'man) -(defvar Man-mode-hook nil - "Hook run when Man mode is enabled.") +(defcustom Man-mode-hook nil + "Hook run when Man mode is enabled." + :type 'hook + :group 'man) -(defvar Man-cooked-hook nil - "Hook run after removing backspaces but before `Man-mode' processing.") +(defcustom Man-cooked-hook nil + "Hook run after removing backspaces but before `Man-mode' processing." + :type 'hook + :group 'man) (defvar Man-name-regexp "[-a-zA-Z0-9_+][-a-zA-Z0-9_.:+]*" "Regular expression describing the name of a manpage (without section).") @@ -330,11 +349,12 @@ This regexp should not start with a `^' character.") (concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?") "Regular expression describing a reference in the SEE ALSO section.") -(defvar Man-switches "" +(defcustom Man-switches "" "Switches passed to the man command, as a single string. - -If you want to be able to see all the manpages for a subject you type, -make -a one of the switches, if your `man' program supports it.") +For example, the -a switch lets you see all the manpages for a +specified subject, if your `man' program supports it." + :type 'string + :group 'man) (defvar Man-specified-section-option (if (string-match "-solaris[0-9.]*$" system-configuration) @@ -348,8 +368,6 @@ make -a one of the switches, if your `man' program supports it.") Otherwise, the value is whatever the function `Man-support-local-filenames' should return.") -;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -;; end user variables ;; other variables and keymap initializations (defvar Man-original-frame) @@ -954,7 +972,6 @@ Return the buffer in which the manpage will appear." Man-width) (Man-width (frame-width)) ((window-width)))))) - (setenv "GROFF_NO_SGR" "1") ;; Since man-db 2.4.3-1, man writes plain text with no escape ;; sequences when stdout is not a tty. In 2.5.0, the following ;; env-var was added to allow control of this (see Debian Bug#340673). @@ -1042,38 +1059,12 @@ Same for the ANSI bold and normal escape sequences." (message "Please wait: formatting the %s man page..." Man-arguments) (goto-char (point-min)) ;; Fontify ANSI escapes. - (let ((faces nil) - (buffer-undo-list t) - (start (point))) - ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html - ;; suggests many codes, but we only handle: - ;; ESC [ 00 m reset to normal display - ;; ESC [ 01 m bold - ;; ESC [ 04 m underline - ;; ESC [ 07 m reverse-video - ;; ESC [ 22 m no-bold - ;; ESC [ 24 m no-underline - ;; ESC [ 27 m no-reverse-video - (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t) - (if faces (put-text-property start (match-beginning 0) 'face - (if (cdr faces) faces (car faces)))) - (setq faces - (cond - ((match-beginning 2) - (delq (pcase (char-after (match-beginning 2)) - (?2 Man-overstrike-face) - (?4 Man-underline-face) - (?7 Man-reverse-face)) - faces)) - ((eq (char-after (match-beginning 1)) ?0) nil) - (t - (cons (pcase (char-after (match-beginning 1)) - (?1 Man-overstrike-face) - (?4 Man-underline-face) - (?7 Man-reverse-face)) - faces)))) - (delete-region (match-beginning 0) (match-end 0)) - (setq start (point)))) + (let ((ansi-color-apply-face-function + (lambda (beg end face) + (when face + (put-text-property beg end 'face face)))) + (ansi-color-map Man-ansi-color-map)) + (ansi-color-apply-on-region (point-min) (point-max))) ;; Other highlighting. (let ((buffer-undo-list t)) (if (< (buffer-size) (position-bytes (point-max))) @@ -1082,23 +1073,23 @@ Same for the ANSI bold and normal escape sequences." (goto-char (point-min)) (while (search-forward "__\b\b" nil t) (backward-delete-char 4) - (put-text-property (point) (1+ (point)) 'face Man-underline-face)) + (put-text-property (point) (1+ (point)) 'face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b\b__" nil t) (backward-delete-char 4) - (put-text-property (1- (point)) (point) 'face Man-underline-face)))) + (put-text-property (1- (point)) (point) 'face 'Man-underline)))) (goto-char (point-min)) (while (search-forward "_\b" nil t) (backward-delete-char 2) - (put-text-property (point) (1+ (point)) 'face Man-underline-face)) + (put-text-property (point) (1+ (point)) 'face 'Man-underline)) (goto-char (point-min)) (while (search-forward "\b_" nil t) (backward-delete-char 2) - (put-text-property (1- (point)) (point) 'face Man-underline-face)) + (put-text-property (1- (point)) (point) 'face 'Man-underline)) (goto-char (point-min)) (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t) (replace-match "\\1") - (put-text-property (1- (point)) (point) 'face Man-overstrike-face)) + (put-text-property (1- (point)) (point) 'face 'Man-overstrike)) (goto-char (point-min)) (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o") @@ -1109,7 +1100,7 @@ Same for the ANSI bold and normal escape sequences." (put-text-property (1- (point)) (point) 'face 'bold)) ;; When the header is longer than the manpage name, groff tries to ;; condense it to a shorter line interspersed with ^H. Remove ^H with - ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) + ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) (goto-char (point-min)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (goto-char (point-min)) @@ -1120,7 +1111,7 @@ Same for the ANSI bold and normal escape sequences." (while (re-search-forward Man-heading-regexp nil t) (put-text-property (match-beginning 0) (match-end 0) - 'face Man-overstrike-face))) + 'face 'Man-overstrike))) (message "%s man page formatted" (Man-page-from-arguments Man-arguments))) (defun Man-highlight-references (&optional xref-man-type) @@ -1203,7 +1194,7 @@ script would have done them." (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+")) ;; When the header is longer than the manpage name, groff tries to ;; condense it to a shorter line interspersed with ^H. Remove ^H with - ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) + ;; their preceding chars (but don't put Man-overstrike). (Bug#5566) (goto-char (point-min)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (Man-softhyphen-to-minus) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 619510e8833..010b4edfb05 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -637,11 +637,11 @@ FNAME is the minor mode's name (variable and function). DOC is the text to use for the menu entry. HELP is the text to use for the tooltip. PROPS are additional properties." - `(list 'menu-item ,doc ',fname - ,@(mapcar (lambda (p) (list 'quote p)) props) - :help ,help - :button '(:toggle . (and (default-boundp ',fname) - (default-value ',fname))))) + `'(menu-item ,doc ,fname + ,@props + :help ,help + :button (:toggle . (and (default-boundp ',fname) + (default-value ',fname))))) (defmacro menu-bar-make-toggle (name variable doc message help &rest body) `(progn @@ -664,10 +664,10 @@ by \"Save Options\" in Custom buffers.") ;; a candidate for "Save Options", and we do not want to save options ;; the user have already set explicitly in his init file. (if interactively (customize-mark-as-set ',variable))) - (list 'menu-item ,doc ',name - :help ,help - :button '(:toggle . (and (default-boundp ',variable) - (default-value ',variable)))))) + '(menu-item ,doc ,name + :help ,help + :button (:toggle . (and (default-boundp ',variable) + (default-value ',variable)))))) ;; Function for setting/saving default font. @@ -1490,8 +1490,6 @@ mail status in mode line")) (bindings--define-key menu [separator-vc] menu-bar-separator) - (bindings--define-key menu [pcl-cvs] - '(menu-item "PCL-CVS" cvs-global-menu)) (bindings--define-key menu [vc] nil) ;Create the place for the VC menu. (bindings--define-key menu [separator-compare] diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 5c2c14d1fdb..cc2638d58de 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2259,14 +2259,24 @@ such as making the current buffer visit no file in the case of (defun read-file-name (prompt &optional dir default-filename mustmatch initial predicate) "Read file name, prompting with PROMPT and completing in directory DIR. Value is not expanded---you must call `expand-file-name' yourself. -Default name to DEFAULT-FILENAME if user exits the minibuffer with -the same non-empty string that was inserted by this function. - (If DEFAULT-FILENAME is omitted, the visited file name is used, - except that if INITIAL is specified, that combined with DIR is used. - If DEFAULT-FILENAME is a list of file names, the first file name is used.) -If the user exits with an empty minibuffer, this function returns -an empty string. (This can only happen if the user erased the -pre-inserted contents or if `insert-default-directory' is nil.) + +DIR is the directory to use for completing relative file names. +It should be an absolute directory name, or nil (which means the +current buffer's value of `default-directory'). + +DEFAULT-FILENAME specifies the default file name to return if the +user exits the minibuffer with the same non-empty string inserted +by this function. If DEFAULT-FILENAME is a string, that serves +as the default. If DEFAULT-FILENAME is a list of strings, the +first string is the default. If DEFAULT-FILENAME is omitted or +nil, then if INITIAL is non-nil, the default is DIR combined with +INITIAL; otherwise, if the current buffer is visiting a file, +that file serves as the default; otherwise, the default is simply +the string inserted into the minibuffer. + +If the user exits with an empty minibuffer, return an empty +string. (This happens only if the user erases the pre-inserted +contents, or if `insert-default-directory' is nil.) Fourth arg MUSTMATCH can take the following values: - nil means that the user can exit with any input. @@ -2283,10 +2293,10 @@ Fourth arg MUSTMATCH can take the following values: Fifth arg INITIAL specifies text to start with. -If optional sixth arg PREDICATE is non-nil, possible completions and -the resulting file name must satisfy (funcall PREDICATE NAME). -DIR should be an absolute directory name. It defaults to the value of -`default-directory'. +Sixth arg PREDICATE, if non-nil, should be a function of one +argument; then a file name is considered an acceptable completion +alternative only if PREDICATE returns non-nil with the file name +as its argument. If this command was invoked with the mouse, use a graphical file dialog if `use-dialog-box' is non-nil, and the window system or X diff --git a/lisp/mouse.el b/lisp/mouse.el index 71336c08ee3..589bbd67b1b 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -1,4 +1,4 @@ -;;; mouse.el --- window system-independent mouse support +;;; mouse.el --- window system-independent mouse support -*- lexical-binding: t -*- ;; Copyright (C) 1993-1995, 1999-2012 Free Software Foundation, Inc. @@ -101,11 +101,8 @@ point at the click position." "Popup the given menu and call the selected option. MENU can be a keymap, an easymenu-style menu or a list of keymaps as for `x-popup-menu'. - -POSITION can be a click event or ((XOFFSET YOFFSET) WINDOW) and -defaults to the current mouse position. If POSITION is the -symbol `point', the current point position is used. - +The menu is shown at the place where POSITION specifies. About +the form of POSITION, see `popup-menu-normalize-position'. PREFIX is the prefix argument (if any) to pass to the command." (let* ((map (cond ((keymapp menu) menu) @@ -114,18 +111,8 @@ PREFIX is the prefix argument (if any) to pass to the command." (filter (when (symbolp map) (plist-get (get map 'menu-prop) :filter)))) (if filter (funcall filter (symbol-function map)) map))))) - event cmd) - (setq position - (cond - ((eq position 'point) - (let* ((pp (posn-at-point)) - (xy (posn-x-y pp))) - (list (list (car xy) (cdr xy)) (posn-window pp)))) - ((not position) - (let ((mp (mouse-pixel-position))) - (list (list (cadr mp) (cddr mp)) (car mp)))) - (t - position))) + event cmd + (position (popup-menu-normalize-position position))) ;; The looping behavior was taken from lmenu's popup-menu-popup (while (and map (setq event ;; map could be a prefix key, in which case @@ -163,6 +150,26 @@ PREFIX is the prefix argument (if any) to pass to the command." ;; mouse-major-mode-menu was using `command-execute' instead. (call-interactively cmd)))) +(defun popup-menu-normalize-position (position) + "Convert the POSITION to the form which `popup-menu' expects internally. +POSITION can an event, a posn- value, a value having +form ((XOFFSET YOFFSET) WINDOW), or nil. +If nil, the current mouse position is used." + (pcase position + ;; nil -> mouse cursor position + (`nil + (let ((mp (mouse-pixel-position))) + (list (list (cadr mp) (cddr mp)) (car mp)))) + ;; Value returned from `event-end' or `posn-at-point'. + ((pred posnp) + (let ((xy (posn-x-y position))) + (list (list (car xy) (cdr xy)) + (posn-window position)))) + ;; Event. + ((pred eventp) + (popup-menu-normalize-position (event-end position))) + (t position))) + (defun minor-mode-menu-from-indicator (indicator) "Show menu for minor mode specified by INDICATOR. Interactively, INDICATOR is read using completion. diff --git a/lisp/mpc.el b/lisp/mpc.el index ff5ce801c63..e8b5c50e561 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -184,7 +184,7 @@ numerically rather than lexicographically." (abs res)) res)))))))) -(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.2") +(define-obsolete-function-alias 'mpc-string-prefix-p 'string-prefix-p "24.3") ;; This can speed up mpc--song-search significantly. The table may grow ;; very large, tho. It's only bounded by the fact that it gets flushed @@ -199,9 +199,10 @@ numerically rather than lexicographically." (defcustom mpc-host (concat (or (getenv "MPD_HOST") "localhost") (if (getenv "MPD_PORT") (concat ":" (getenv "MPD_PORT")))) - "Host (and port) where the Music Player Daemon is running. -The format is \"HOST\" or \"HOST:PORT\" where PORT defaults to 6600 -and HOST defaults to localhost." + "Host (and port) where the Music Player Daemon is running. The +format is \"HOST\", \"HOST:PORT\", \"PASSWORD@HOST\" or +\"PASSWORD@HOST:PORT\" where PASSWORD defaults to no password, PORT +defaults to 6600 and HOST defaults to localhost." :type 'string) (defvar mpc-proc nil) @@ -252,20 +253,30 @@ and HOST defaults to localhost." (funcall callback))))))))) (defun mpc--proc-connect (host) - (mpc--debug "Connecting to %s..." host) - (with-current-buffer (get-buffer-create (format " *mpc-%s*" host)) - ;; (pop-to-buffer (current-buffer)) - (let (proc) - (while (and (setq proc (get-buffer-process (current-buffer))) - (progn ;; (debug) - (delete-process proc))))) - (erase-buffer) - (let ((port 6600)) - (when (string-match ":[^.]+\\'" host) - (setq port (substring host (1+ (match-beginning 0)))) - (setq host (substring host 0 (match-beginning 0))) - (unless (string-match "[^[:digit:]]" port) - (setq port (string-to-number port)))) + (let ((port 6600) + pass) + + (when (string-match "\\`\\(?:\\(.*\\)@\\)?\\(.*?\\)\\(?::\\(.*\\)\\)?\\'" + host) + (let ((v (match-string 1 host))) + (when (and (stringp v) (not (string= "" v))) + (setq pass v))) + (let ((v (match-string 3 host))) + (setq host (match-string 2 host)) + (when (and (stringp v) (not (string= "" v))) + (setq port + (if (string-match "[^[:digit:]]" v) + (string-to-number v) + v))))) + + (mpc--debug "Connecting to %s:%s..." host port) + (with-current-buffer (get-buffer-create (format " *mpc-%s:%s*" host port)) + ;; (pop-to-buffer (current-buffer)) + (let (proc) + (while (and (setq proc (get-buffer-process (current-buffer))) + (progn ;; (debug) + (delete-process proc))))) + (erase-buffer) (let* ((coding-system-for-read 'utf-8-unix) (coding-system-for-write 'utf-8-unix) (proc (open-network-stream "MPC" (current-buffer) host port))) @@ -282,7 +293,9 @@ and HOST defaults to localhost." (set-process-query-on-exit-flag proc nil) ;; This may be called within a process filter ;-( (with-local-quit (mpc-proc-sync proc)) - proc)))) + (setq mpc-proc proc) + (when pass + (mpc-proc-cmd (list "password" pass) nil)))))) (defun mpc--proc-quote-string (s) (if (numberp s) (number-to-string s) @@ -306,11 +319,11 @@ and HOST defaults to localhost." (nreverse alists))) (defun mpc-proc () - (or (and mpc-proc - (buffer-live-p (process-buffer mpc-proc)) - (not (memq (process-status mpc-proc) '(closed))) - mpc-proc) - (setq mpc-proc (mpc--proc-connect mpc-host)))) + (unless (and mpc-proc + (buffer-live-p (process-buffer mpc-proc)) + (not (memq (process-status mpc-proc) '(closed)))) + (mpc--proc-connect mpc-host)) + mpc-proc) (defun mpc-proc-check (proc) (let ((error-text (process-get proc 'mpc-proc-error))) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index d0200f4cb9d..772a0a9c626 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -280,7 +280,7 @@ object is returned instead of a list containing this single Lisp object. ;; `dbus-call-method' works non-blocking now. (defalias 'dbus-call-method-non-blocking 'dbus-call-method) -(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.2") +(make-obsolete 'dbus-call-method-non-blocking 'dbus-call-method "24.3") (defun dbus-call-method-asynchronously (bus service path interface method handler &rest args) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 853839c2061..531f0730652 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -68,7 +68,7 @@ ;; imap-body-lines ;; ;; It is my hope that these commands should be pretty self -;; explanatory for someone that know IMAP. All functions have +;; explanatory for someone who knows IMAP. All functions have ;; additional documentation on how to invoke them. ;; ;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1). The implemented @@ -838,9 +838,10 @@ sure of changing the value of `foo'." (defun imap-interactive-login (buffer loginfunc) "Login to server in BUFFER. -LOGINFUNC is passed a username and a password, it should return t if -it where successful authenticating itself to the server, nil otherwise. -Returns t if login was successful, nil otherwise." +Return t if login was successful, nil otherwise. + +LOGINFUNC is passed a username and a password. It should return +t if it successfully authenticates, nil otherwise." (with-current-buffer buffer (make-local-variable 'imap-username) (make-local-variable 'imap-password) @@ -1187,11 +1188,12 @@ respond. If BUFFER is nil, the current buffer is used." (defun imap-authenticate (&optional user passwd buffer) "Authenticate to server in BUFFER, using current buffer if nil. -It uses the authenticator specified when opening the server. If the -authenticator requires username/passwords, they are queried from the -user and optionally stored in the buffer. If USER and/or PASSWD is -specified, the user will not be questioned and the username and/or -password is remembered in the buffer." +It uses the authenticator specified when opening the server. + +Optional arguments USER and PASSWD specify the username and +password to use if the authenticator requires a username and/or +password. If omitted or nil, the authenticator may query the +user for a username and/or password." (with-current-buffer (or buffer (current-buffer)) (if (not (eq imap-state 'nonauth)) (or (eq imap-state 'auth) @@ -1475,7 +1477,7 @@ If BUFFER is nil the current buffer is assumed." (defun imap-mailbox-lsub (&optional root reference add-delimiter buffer) "Return a list of subscribed mailboxes on server in BUFFER. If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is -non-nil, a hierarchy delimiter is added to root. REFERENCE is a +non-nil, a hierarchy delimiter is added to root. REFERENCE is an implementation-specific string that has to be passed to lsub command." (with-current-buffer (or buffer (current-buffer)) ;; Make sure we know the hierarchy separator for root's hierarchy @@ -1499,7 +1501,7 @@ implementation-specific string that has to be passed to lsub command." (defun imap-mailbox-list (root &optional reference add-delimiter buffer) "Return a list of mailboxes matching ROOT on server in BUFFER. If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to -root. REFERENCE is a implementation-specific string that has to be +root. REFERENCE is an implementation-specific string that has to be passed to list command." (with-current-buffer (or buffer (current-buffer)) ;; Make sure we know the hierarchy separator for root's hierarchy @@ -1559,7 +1561,7 @@ returned, if ITEMS is a symbol only its value is returned." (imap-mailbox-get items mailbox))))) (defun imap-mailbox-status-asynch (mailbox items &optional buffer) - "Send status item request ITEM on MAILBOX to server in BUFFER. + "Send status item requests ITEMS on MAILBOX to server in BUFFER. ITEMS can be a symbol or a list of symbols, valid symbols are one of the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity or 'unseen. The IMAP command tag is returned." @@ -1596,7 +1598,7 @@ or 'unseen. The IMAP command tag is returned." rights)))))) (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) - "Remove any pair for IDENTIFIER in MAILBOX from server in BUFFER." + "Remove pairs for IDENTIFIER from MAILBOX on server in BUFFER." (let ((mailbox (imap-utf7-encode mailbox))) (with-current-buffer (or buffer (current-buffer)) (imap-ok-p @@ -1642,8 +1644,8 @@ or 'unseen. The IMAP command tag is returned." (defun imap-fetch (uids props &optional receive nouidfetch buffer) "Fetch properties PROPS from message set UIDS from server in BUFFER. -UIDS can be a string, number or a list of numbers. If RECEIVE -is non-nil return these properties." +UIDS can be a string, number or a list of numbers. If RECEIVE is +non-nil, return these properties." (with-current-buffer (or buffer (current-buffer)) (when (imap-ok-p (imap-send-command-wait (format "%sFETCH %s %s" (if nouidfetch "" "UID ") @@ -1743,7 +1745,8 @@ is non-nil return these properties." (imap-mailbox-get-1 'search imap-current-mailbox))))) (defun imap-message-flag-permanent-p (flag &optional mailbox buffer) - "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER." + "Return t if FLAG can be permanently saved on articles. +MAILBOX specifies a mailbox on the server in BUFFER." (with-current-buffer (or buffer (current-buffer)) (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox)) (member flag (imap-mailbox-get 'permanentflags mailbox))))) @@ -1918,7 +1921,7 @@ on failure." 0)) (defun imap-envelope-from (from) - "Return a from string line." + "Return a FROM string line." (and from (concat (aref from 0) (if (aref from 0) " <") @@ -2285,7 +2288,7 @@ Return nil if no complete line has arrived." ;; ; capability. (defun imap-parse-response () - "Parse a IMAP command response." + "Parse an IMAP command response." (let (token) (case (setq token (read (current-buffer))) (+ (setq imap-continuation diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 85a13a8cf62..27cf50f06ca 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -365,7 +365,7 @@ of a line. The string is passed as the first argument to "When non-nil, kill channel buffers when the server buffer is killed. Only the channel buffers associated with the server in question will be killed." - :version "24.2" + :version "24.3" :type 'boolean :group 'rcirc) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index afb25509e4f..e757247c2a2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3559,26 +3559,30 @@ file exists and nonzero exit status otherwise." ;; `/usr/bin/test'. ;; `/usr/bin/test -e' In case `/bin/test' does not exist. (unless (or - (and (setq result (format "%s -e" (tramp-get-test-command vec))) - (tramp-send-command-and-check - vec (format "%s %s" result existing)) - (not (tramp-send-command-and-check - vec (format "%s %s" result nonexistent)))) - (and (setq result "/bin/test -e") - (tramp-send-command-and-check - vec (format "%s %s" result existing)) - (not (tramp-send-command-and-check - vec (format "%s %s" result nonexistent)))) - (and (setq result "/usr/bin/test -e") - (tramp-send-command-and-check - vec (format "%s %s" result existing)) - (not (tramp-send-command-and-check - vec (format "%s %s" result nonexistent)))) - (and (setq result (format "%s -d" (tramp-get-ls-command vec))) - (tramp-send-command-and-check - vec (format "%s %s" result existing)) - (not (tramp-send-command-and-check - vec (format "%s %s" result nonexistent))))) + (ignore-errors + (and (setq result (format "%s -e" (tramp-get-test-command vec))) + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexistent))))) + (ignore-errors + (and (setq result "/bin/test -e") + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexistent))))) + (ignore-errors + (and (setq result "/usr/bin/test -e") + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexistent))))) + (ignore-errors + (and (setq result (format "%s -d" (tramp-get-ls-command vec))) + (tramp-send-command-and-check + vec (format "%s %s" result existing)) + (not (tramp-send-command-and-check + vec (format "%s %s" result nonexistent)))))) (tramp-error vec 'file-error "Couldn't find command to check if file exists")) result)) @@ -3595,11 +3599,14 @@ file exists and nonzero exit status otherwise." (setq item (pop alist)) (when (string-match (car item) shell) (setq extra-args (cdr item)))) - (when extra-args (setq shell (concat shell " " extra-args))) (tramp-send-command - vec (format "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s" - (tramp-shell-quote-argument tramp-end-of-output) shell) + vec (format + "exec env ENV='' PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + (tramp-shell-quote-argument tramp-end-of-output) + shell (or extra-args "")) t)) + (tramp-set-connection-property + (tramp-get-connection-process vec) "remote-shell" shell) ;; Setting prompts. (tramp-send-command vec (format "PS1=%s" (tramp-shell-quote-argument tramp-end-of-output)) t) @@ -3609,48 +3616,54 @@ file exists and nonzero exit status otherwise." (defun tramp-find-shell (vec) "Opens a shell on the remote host which groks tilde expansion." - (with-connection-property vec "remote-shell" - (let ((shell (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-shell))) - (with-current-buffer (tramp-get-buffer vec) - ;; CCC: "root" does not exist always, see QNAP 459. Which - ;; check could we apply instead? - (tramp-send-command vec "echo ~root" t) - (when (or (string-match "^~root$" (buffer-string)) - ;; The default shell (ksh93) of OpenSolaris and - ;; Solaris is buggy. We've got reports for "SunOS - ;; 5.10" and "SunOS 5.11" so far. - (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) - (tramp-get-connection-property vec "uname" ""))) - (if (setq shell - (or (tramp-find-executable - vec "bash" (tramp-get-remote-path vec) t t) - (tramp-find-executable - vec "ksh" (tramp-get-remote-path vec) t t))) - (progn - (tramp-message - vec 5 "Starting remote shell `%s' for tilde expansion" shell) - (tramp-open-shell vec shell)) + (with-current-buffer (tramp-get-buffer vec) + (let ((default-shell + (or + (tramp-get-connection-property + (tramp-get-connection-process vec) "remote-shell" nil) + (tramp-get-method-parameter + (tramp-file-name-method vec) 'tramp-remote-shell))) + shell) + (setq shell + (with-connection-property vec "remote-shell" + ;; CCC: "root" does not exist always, see QNAP 459. + ;; Which check could we apply instead? + (tramp-send-command vec "echo ~root" t) + (if (or (string-match "^~root$" (buffer-string)) + ;; The default shell (ksh93) of OpenSolaris and + ;; Solaris is buggy. We've got reports for + ;; "SunOS 5.10" and "SunOS 5.11" so far. + (string-match (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + (tramp-get-connection-property + vec "uname" ""))) - ;; Maybe it works at least for some other commands. - (setq shell - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-shell)) - (tramp-message - vec 2 - (concat - "Couldn't find a remote shell which groks tilde expansion, " - "using `%s'") - shell))) + (or (tramp-find-executable + vec "bash" (tramp-get-remote-path vec) t t) + (tramp-find-executable + vec "ksh" (tramp-get-remote-path vec) t t) + ;; Maybe it works at least for some other commands. + (prog1 + default-shell + (tramp-message + vec 2 + (concat + "Couldn't find a remote shell which groks tilde " + "expansion, using `%s'") + default-shell))) - ;; Busyboxes tend to behave strange. We check for the existence. - (with-connection-property vec "busybox" - (tramp-send-command vec (format "%s --version" shell) t) - (let ((case-fold-search t)) - (and (string-match "busybox" (buffer-string)) t))) + default-shell))) - ;; Return the shell. - shell)))) + ;; Open a new shell if needed. + (unless (string-equal shell default-shell) + (tramp-message + vec 5 "Starting remote shell `%s' for tilde expansion" shell) + (tramp-open-shell vec shell)) + + ;; Busyboxes tend to behave strange. We check for the existence. + (with-connection-property vec "busybox" + (tramp-send-command vec (format "%s --version" shell) t) + (let ((case-fold-search t)) + (and (string-match "busybox" (buffer-string)) t)))))) ;; Utility functions. @@ -3686,8 +3699,9 @@ process to set up. VEC specifies the connection." ;; discarded as well. (tramp-open-shell vec - (tramp-get-method-parameter - (tramp-file-name-method vec) 'tramp-remote-shell)) + (or (tramp-get-connection-property vec "remote-shell" nil) + (tramp-get-method-parameter + (tramp-file-name-method vec) 'tramp-remote-shell))) ;; Disable echo. (tramp-message vec 5 "Setting up remote shell environment") @@ -3786,7 +3800,7 @@ process to set up. VEC specifies the connection." (tramp-set-remote-path vec) ;; Search for a good shell before searching for a command which - ;; checks if a file exists. This is done because Tramp wants to use + ;; checks if a file exists. This is done because Tramp wants to use ;; "test foo; echo $?" to check if various conditions hold, and ;; there are buggy /bin/sh implementations which don't execute the ;; "echo $?" part if the "test" part has an error. In particular, diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1ea2719a23f..f1d54b6fd3c 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -249,21 +249,21 @@ If it isn't found in the local $PATH, the absolute path of winexe shall be given. This is needed for remote processes." :group 'tramp :type 'string - :version "24.2") + :version "24.3") (defcustom tramp-smb-winexe-shell-command "powershell.exe" "Shell to be used for processes on remote machines. This must be Powershell V2 compatible." :group 'tramp :type 'string - :version "24.2") + :version "24.3") (defcustom tramp-smb-winexe-shell-command-switch "-file -" "Command switch used together with `tramp-smb-winexe-shell-command'. This can be used to disable echo etc." :group 'tramp :type 'string - :version "24.2") + :version "24.3") ;;;###tramp-autoload (defsubst tramp-smb-file-name-p (filename) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 58506ce82f7..848599104c5 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -413,7 +413,7 @@ This is a list of regular expressions, which denote hosts running a registered shell like \"rbash\". Those hosts can be used as proxies only, see `tramp-default-proxies-alist'. If the local host runs a registered shell, it shall be added to this list, too." - :version "24.2" + :version "24.3" :group 'tramp :type '(repeat (regexp :tag "Host regexp"))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 5c8829ff72e..a7fedf20f53 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -283,7 +283,7 @@ Python's PEP8 for example recommends two spaces, so you could do: (lambda () (set (make-local-variable 'comment-inline-offset) 2))) See `comment-padding' for whole-line comments." - :version "24.2" + :version "24.3" :type 'integer :group 'comment) diff --git a/lisp/nxml/nxml-glyph.el b/lisp/nxml/nxml-glyph.el index 86b14e66398..4ac9764af08 100644 --- a/lisp/nxml/nxml-glyph.el +++ b/lisp/nxml/nxml-glyph.el @@ -346,7 +346,7 @@ The constants `nxml-ascii-glyph-set', `nxml-latin1-glyph-set', predefined for use by `nxml-glyph-set-functions'.") (define-obsolete-variable-alias 'nxml-glyph-set-hook - 'nxml-glyph-set-functions "24.2") + 'nxml-glyph-set-functions "24.3") (defvar nxml-glyph-set nil "Used by `nxml-glyph-set-functions' to return set of glyphs in a FACE. diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el index d0738dfeb2c..5d213d193b3 100644 --- a/lisp/obsolete/assoc.el +++ b/lisp/obsolete/assoc.el @@ -4,7 +4,7 @@ ;; Author: Barry A. Warsaw ;; Keywords: extensions -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el index 1dd69c129a0..bd7d9a6e6bf 100644 --- a/lisp/obsolete/bruce.el +++ b/lisp/obsolete/bruce.el @@ -6,7 +6,7 @@ ;; Maintainer: FSF ;; Keywords: games ;; Created: Jan 1997 -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el index 6be200d245c..fc00975ba37 100644 --- a/lisp/obsolete/cust-print.el +++ b/lisp/obsolete/cust-print.el @@ -5,7 +5,7 @@ ;; Author: Daniel LaLiberte ;; Adapted-By: ESR ;; Keywords: extensions -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;; LCD Archive Entry: ;; cust-print|Daniel LaLiberte|liberte@holonexus.org diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el index 08e71aa5d2d..df6cb7b9db6 100644 --- a/lisp/obsolete/ledit.el +++ b/lisp/obsolete/ledit.el @@ -4,7 +4,7 @@ ;; Maintainer: FSF ;; Keywords: languages -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el index 158523e8ef2..b6bf0d1e1b9 100644 --- a/lisp/obsolete/mailpost.el +++ b/lisp/obsolete/mailpost.el @@ -9,7 +9,7 @@ ;; Maintainer: FSF ;; Created: 13 Jan 1986 ;; Keywords: mail -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;;; Commentary: diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index 45396d30ea5..8df4b3613ed 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -4,7 +4,7 @@ ;; Author: Mike Williams ;; Keywords: mouse -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;; This file is part of GNU Emacs. @@ -263,7 +263,7 @@ kill ring; mouse-1 or mouse-3 kills it." interprogram-paste-function mouse-sel-original-interprogram-paste-function)))) -(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.2") +(make-obsolete 'mouse-sel-mode "use the normal mouse modes" "24.3") ;;=== Internal Variables/Constants ======================================== diff --git a/lisp/obsolete/patcomp.el b/lisp/obsolete/patcomp.el index b8304143e9f..9aacdd8f4c3 100644 --- a/lisp/obsolete/patcomp.el +++ b/lisp/obsolete/patcomp.el @@ -2,7 +2,7 @@ ;; This file is part of GNU Emacs. -;; Obsolete-since: 24.2 +;; Obsolete-since: 24.3 ;;; Commentary: diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index e637c3407f0..f2d1618f124 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -44,7 +44,7 @@ (push "--nosignature" opts)))) opts) "String, or list of strings, with extra options for an rpm query command." - :version "24.2" + :version "24.3" :type '(choice (const :tag "No options" nil) (string :tag "Single option") (repeat :tag "List of options" string)) @@ -52,7 +52,7 @@ (defcustom pcmpl-rpm-cache t "Whether to cache the list of installed packages." - :version "24.2" + :version "24.3" :type 'boolean :group 'pcmpl-rpm) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index b71bfb202db..d357da685e5 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -165,7 +165,7 @@ A non-nil value is useful if `pcomplete-autolist' is non-nil too." :group 'pcomplete) (define-obsolete-variable-alias - 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.2") + 'pcomplete-arg-quote-list 'comint-file-name-quote-list "24.3") (defcustom pcomplete-man-function 'man "A function to that will be called to display a manual page. @@ -791,7 +791,7 @@ this is `comint-dynamic-complete-functions'." pcomplete-args)))))) (define-obsolete-function-alias - 'pcomplete-quote-argument #'comint-quote-filename "24.2") + 'pcomplete-quote-argument #'comint-quote-filename "24.3") ;; file-system completion lists diff --git a/lisp/proced.el b/lisp/proced.el index 78afcac9f50..d98bf7d2c5b 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -659,11 +659,14 @@ After displaying or updating a Proced buffer, Proced runs the normal hook ;;;###autoload (defun proced (&optional arg) "Generate a listing of UNIX system processes. -If invoked with optional ARG the window displaying the process -information will be displayed but not selected. -Runs the normal hook `proced-post-display-hook'. +\\ +If invoked with optional ARG, do not select the window displaying +the process information. -See `proced-mode' for a description of features available in Proced buffers." +This function runs the normal hook `proced-post-display-hook'. + +See `proced-mode' for a description of features available in +Proced buffers." (interactive "P") (unless proced-available (error "Proced is not available on this system")) diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index c9c6a0b9dc6..ac3a7282952 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -35,8 +35,6 @@ ;;; Code: -(defvar font-lock-syntactic-keywords) - (defvar autoconf-mode-map (make-sparse-keymap)) (defvar autoconf-mode-hook nil diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index c008e1c4da3..21a323d8b45 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -684,13 +684,13 @@ starting the compilation process." (t (:inverse-video t :weight bold))) "Face for Compilation mode's \"error\" mode line indicator." :group 'compilation - :version "24.2") + :version "24.3") (defface compilation-mode-line-run '((t :inherit compilation-warning)) "Face for Compilation mode's \"running\" mode line indicator." :group 'compilation - :version "24.2") + :version "24.3") (defface compilation-mode-line-exit '((default :inherit compilation-info) @@ -700,7 +700,7 @@ starting the compilation process." (t (:weight bold))) "Face for Compilation mode's \"exit\" mode line indicator." :group 'compilation - :version "24.2") + :version "24.3") (defface compilation-line-number '((t :inherit font-lock-keyword-face)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d9b50ea3cc3..e1430b67e99 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1838,7 +1838,13 @@ or as help on variables `cperl-tips', `cperl-problems', (set (make-local-variable 'cperl-syntax-done-to) nil) (set (make-local-variable 'syntax-propertize-function) (lambda (start end) - (goto-char start) (cperl-fontify-syntaxically end)))) + (goto-char start) + ;; Even if cperl-fontify-syntaxically has already gone + ;; beyond `start', syntax-propertize has just removed + ;; syntax-table properties between start and end, so we have + ;; to re-apply them. + (setq cperl-syntax-done-to start) + (cperl-fontify-syntaxically end)))) (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 80afdc0bedf..0a99c2f5c24 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -944,11 +944,16 @@ no input, and GDB is waiting for input." (defun gdb-tooltip-print (expr) (with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer) (goto-char (point-min)) - (if (re-search-forward ".*value=\\(\".*\"\\)" nil t) - (tooltip-show - (concat expr " = " (read (match-string 1))) - (or gud-tooltip-echo-area - (not (display-graphic-p))))))) + (cond + ((re-search-forward ".*value=\\(\".*\"\\)" nil t) + (tooltip-show + (concat expr " = " (read (match-string 1))) + (or gud-tooltip-echo-area + (not (display-graphic-p))))) + ((re-search-forward "msg=\\(\".+\"\\)$" nil t) + (tooltip-show (read (match-string 1)) + (or gud-tooltip-echo-area + (not (display-graphic-p)))))))) ;; If expr is a macro for a function don't print because of possible dangerous ;; side-effects. Also printing a function within a tooltip generates an @@ -958,7 +963,7 @@ no input, and GDB is waiting for input." (goto-char (point-min)) (if (search-forward "expands to: " nil t) (unless (looking-at "\\S-+.*(.*).*") - (gdb-input (concat "-data-evaluate-expression " expr) + (gdb-input (concat "-data-evaluate-expression \"" expr "\"") `(lambda () (gdb-tooltip-print ,expr))))))) (defun gdb-init-buffer () @@ -1513,12 +1518,13 @@ DOC is an optional documentation string." ;; Set up inferior I/O. Needs GDB 6.4 onwards. (set-process-filter proc 'gdb-inferior-filter) (set-process-sentinel proc 'gdb-inferior-io-sentinel) - (gdb-input - (concat "-inferior-tty-set " - ;; The process can run on a remote host. - (or (process-get proc 'remote-tty) - (process-tty-name proc))) - 'ignore)) + ;; The process can run on a remote host. + (let ((tty (or (process-get proc 'remote-tty) + (process-tty-name proc)))) + (unless (or (null tty) + (string= tty "")) + (gdb-input + (concat "-inferior-tty-set " tty) 'ignore)))) (defun gdb-inferior-io-sentinel (proc str) (when (eq (process-status proc) 'failed) @@ -2100,13 +2106,15 @@ current thread and update GDB buffers." (setq gdb-filter-output (gdb-concat-output gdb-filter-output - (let ((error-message - (read output-field))) - (put-text-property - 0 (length error-message) - 'face font-lock-warning-face - error-message) - error-message)))) + (if (string= output-field "\"\\n\"") + "" + (let ((error-message + (read output-field))) + (put-text-property + 0 (length error-message) + 'face font-lock-warning-face + error-message) + error-message))))) ;; Remove the trimmings from the console stream and send to GUD buffer ;; (frontend MI commands should not print to this stream) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 8912e67d603..5946e93f34d 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3411,7 +3411,7 @@ With arg, dereference expr if ARG is positive, otherwise do not dereference." (defun gud-tooltip-print-command (expr) "Return a suitable command to print the expression EXPR." (pcase gud-minor-mode - (`gdbmi (concat "-data-evaluate-expression " expr)) + (`gdbmi (concat "-data-evaluate-expression \"" expr "\"")) (`dbx (concat "print " expr)) ((or `xdb `pdb) (concat "p " expr)) (`sdb (concat expr "/")))) @@ -3456,7 +3456,10 @@ This function must return nil if it doesn't handle EVENT." (let ((cmd (gud-tooltip-print-command expr))) (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb)) (gud-tooltip-mode -1) - (message-box "Using GUD tooltips in this mode is unsafe\n\ + ;; The blank before the newline is for MS-Windows, + ;; whose emulation of message box removes newlines and + ;; displays a single long line. + (message-box "Using GUD tooltips in this mode is unsafe \n\ so they have been disabled.")) (unless (null cmd) ; CMD can be nil if unknown debugger (if (eq gud-minor-mode 'gdbmi) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 848b92868e7..e13b67e596d 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -509,7 +509,7 @@ If nil, continued arguments are aligned with the first argument." "Non-nil means that non-block ()-, {}- and []-groups are indented as blocks. The closing bracket is aligned with the line of the opening bracket, not the contents of the brackets." - :version "24.2" + :version "24.3" :type 'boolean :group 'perl) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f946509d6e0..601850ed0fb 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -54,7 +54,7 @@ ;; `python-nav-beginning-of-statement', `python-nav-end-of-statement', ;; `python-nav-beginning-of-block' and `python-nav-end-of-block' are ;; included but no bound to any key. At last but not least the -;; specialized `python-nav-forward-sexp-function' allows easy +;; specialized `python-nav-forward-sexp' allows easy ;; navigation between code blocks. ;; Shell interaction: is provided and allows you to execute easily any @@ -353,6 +353,40 @@ This variant of `rx' supports common python named REGEXPS." ;;; Font-lock and syntax + +(defun python-syntax-context (type &optional syntax-ppss) + "Return non-nil if point is on TYPE using SYNTAX-PPSS. +TYPE can be `comment', `string' or `paren'. It returns the start +character address of the specified TYPE." + (let ((ppss (or syntax-ppss (syntax-ppss)))) + (case type + (comment (and (nth 4 ppss) (nth 8 ppss))) + (string (and (not (nth 4 ppss)) (nth 8 ppss))) + (paren (nth 1 ppss)) + (t nil)))) + +(defun python-syntax-context-type (&optional syntax-ppss) + "Return the context type using SYNTAX-PPSS. +The type returned can be `comment', `string' or `paren'." + (let ((ppss (or syntax-ppss (syntax-ppss)))) + (cond + ((nth 8 ppss) (if (nth 4 ppss) 'comment 'string)) + ((nth 1 ppss) 'paren)))) + +(defsubst python-syntax-comment-or-string-p () + "Return non-nil if point is inside 'comment or 'string." + (nth 8 (syntax-ppss))) + +(define-obsolete-function-alias + 'python-info-ppss-context #'python-syntax-context "24.3") + +(define-obsolete-function-alias + 'python-info-ppss-context-type #'python-syntax-context-type "24.3") + +(define-obsolete-function-alias + 'python-info-ppss-comment-or-string-p + #'python-syntax-comment-or-string-p "24.3") + (defvar python-font-lock-keywords ;; Keywords `(,(rx symbol-start @@ -439,9 +473,9 @@ This variant of `rx' supports common python named REGEXPS." (? ?\[ (+ (not (any ?\]))) ?\]) (* space) assignment-operator))) (when (re-search-forward re limit t) - (while (and (python-info-ppss-context 'paren) + (while (and (python-syntax-context 'paren) (re-search-forward re limit t))) - (if (and (not (python-info-ppss-context 'paren)) + (if (and (not (python-syntax-context 'paren)) (not (equal (char-after (point-marker)) ?=))) t (set-match-data nil))))) @@ -454,10 +488,10 @@ This variant of `rx' supports common python named REGEXPS." assignment-operator))) (when (and (re-search-forward re limit t) (goto-char (nth 3 (match-data)))) - (while (and (python-info-ppss-context 'paren) + (while (and (python-syntax-context 'paren) (re-search-forward re limit t)) (goto-char (nth 3 (match-data)))) - (if (not (python-info-ppss-context 'paren)) + (if (not (python-syntax-context 'paren)) t (set-match-data nil))))) (1 font-lock-variable-name-face nil nil)))) @@ -554,10 +588,10 @@ It makes underscores and dots word constituent chars.") :safe 'booleanp) (define-obsolete-variable-alias - 'python-indent 'python-indent-offset "24.2") + 'python-indent 'python-indent-offset "24.3") (define-obsolete-variable-alias - 'python-guess-indent 'python-indent-guess-indent-offset "24.2") + 'python-guess-indent 'python-indent-guess-indent-offset "24.3") (defvar python-indent-current-level 0 "Current indentation level `python-indent-line-function' is using.") @@ -582,7 +616,7 @@ These make `python-indent-calculate-indentation' subtract the value of (re-search-forward (python-rx line-start block-start) nil t)) (when (and - (not (python-info-ppss-context-type)) + (not (python-syntax-context-type)) (progn (goto-char (line-end-position)) (python-util-forward-comment -1) @@ -632,14 +666,14 @@ START is the buffer position where the sexp starts." (bobp)) 'no-indent) ;; Inside a paren - ((setq start (python-info-ppss-context 'paren ppss)) + ((setq start (python-syntax-context 'paren ppss)) 'inside-paren) ;; Inside string - ((setq start (python-info-ppss-context 'string ppss)) + ((setq start (python-syntax-context 'string ppss)) 'inside-string) ;; After backslash - ((setq start (when (not (or (python-info-ppss-context 'string ppss) - (python-info-ppss-context 'comment ppss))) + ((setq start (when (not (or (python-syntax-context 'string ppss) + (python-syntax-context 'comment ppss))) (let ((line-beg-pos (line-beginning-position))) (when (python-info-line-ends-backslash-p (1- line-beg-pos)) @@ -657,7 +691,7 @@ START is the buffer position where the sexp starts." (while (and (re-search-backward (python-rx block-start) nil t) (or - (python-info-ppss-context-type) + (python-syntax-context-type) (python-info-continuation-line-p)))) (when (looking-at (python-rx block-start)) (point-marker))))) @@ -721,13 +755,13 @@ START is the buffer position where the sexp starts." (while (prog2 (forward-line -1) (and (not (bobp)) - (python-info-ppss-context 'paren)))) + (python-syntax-context 'paren)))) (goto-char (line-end-position)) (while (and (re-search-backward "\\." (line-beginning-position) t) - (python-info-ppss-context-type))) + (python-syntax-context-type))) (if (and (looking-at "\\.") - (not (python-info-ppss-context-type))) + (not (python-syntax-context-type))) ;; The indentation is the same column of the ;; first matching dot that's not inside a ;; comment, a string or a paren @@ -783,7 +817,7 @@ START is the buffer position where the sexp starts." (when (and (looking-at (regexp-opt '(")" "]" "}"))) (progn (forward-char 1) - (not (python-info-ppss-context 'paren)))) + (not (python-syntax-context 'paren)))) (goto-char context-start) (current-indentation)))) ;; If open paren is contained on a line by itself add another @@ -883,7 +917,7 @@ See `python-indent-line' for details." (defun python-indent-dedent-line () "De-indent current line." (interactive "*") - (when (and (not (python-info-ppss-comment-or-string-p)) + (when (and (not (python-syntax-comment-or-string-p)) (<= (point-marker) (save-excursion (back-to-indentation) (point-marker))) @@ -974,7 +1008,7 @@ With numeric ARG, just insert that many colons. With (when (and (not arg) (eolp) (not (equal ?: (char-after (- (point-marker) 2)))) - (not (python-info-ppss-comment-or-string-p))) + (not (python-syntax-comment-or-string-p))) (let ((indentation (current-indentation)) (calculated-indentation (python-indent-calculate-indentation))) (python-info-closing-block-message) @@ -998,7 +1032,7 @@ automatically if needed." (goto-char (line-beginning-position)) ;; If after going to the beginning of line the point ;; is still inside a paren it's ok to do the trick - (when (python-info-ppss-context 'paren) + (when (python-syntax-context 'paren) (let ((indentation (python-indent-calculate-indentation))) (when (< (current-indentation) indentation) (indent-line-to indentation))))))) @@ -1032,7 +1066,7 @@ non-nil if point is moved to `beginning-of-defun'." (end-of-line 1)) (while (and (funcall re-search-fn python-nav-beginning-of-defun-regexp nil t) - (python-info-ppss-context-type))) + (python-syntax-context-type))) (and (python-info-looking-at-beginning-of-defun) (or (not (= (line-number-at-pos pos) (line-number-at-pos))) @@ -1082,15 +1116,15 @@ Returns nil if point is not in a def or class." (equal (char-after (+ (point) (current-indentation))) ?#) (<= (current-indentation) beg-defun-indent) (looking-at (python-rx decorator)) - (python-info-ppss-context-type)))) + (python-syntax-context-type)))) (forward-line 1) ;; If point falls inside a paren or string context the point is ;; forwarded at the end of it (or end of buffer if its not closed) - (let ((context-type (python-info-ppss-context-type))) + (let ((context-type (python-syntax-context-type))) (when (memq context-type '(paren string)) ;; Slow but safe. (while (and (not (eobp)) - (python-info-ppss-context-type)) + (python-syntax-context-type)) (forward-line 1))))))) (defun python-nav-beginning-of-statement () @@ -1102,8 +1136,8 @@ Returns nil if point is not in a def or class." (save-excursion (forward-line -1) (python-info-line-ends-backslash-p)) - (python-info-ppss-context 'string) - (python-info-ppss-context 'paren)) + (python-syntax-context 'string) + (python-syntax-context 'paren)) (forward-line -1))))) (defun python-nav-end-of-statement () @@ -1113,8 +1147,8 @@ Returns nil if point is not in a def or class." (not (eobp)) (when (or (python-info-line-ends-backslash-p) - (python-info-ppss-context 'string) - (python-info-ppss-context 'paren)) + (python-syntax-context 'string) + (python-syntax-context 'paren)) (forward-line 1))))) (defun python-nav-backward-statement (&optional arg) @@ -1202,96 +1236,191 @@ backward to previous block." (python-nav-end-of-statement) (while (and (re-search-forward block-start-regexp nil t) - (python-info-ppss-context-type))) + (python-syntax-context-type))) (setq arg (1- arg))) (while (< arg 0) (python-nav-beginning-of-statement) (while (and (re-search-backward block-start-regexp nil t) - (python-info-ppss-context-type))) + (python-syntax-context-type))) (setq arg (1+ arg))) (python-nav-beginning-of-statement) (if (not (looking-at (python-rx block-start))) (and (goto-char starting-pos) nil) (and (not (= (point) starting-pos)) (point-marker))))) -(defun python-nav-forward-sexp-function (&optional arg) +(defun python-nav-lisp-forward-sexp-safe (&optional arg) + "Safe version of standard `forward-sexp'. +When ARG > 0 move forward, else if ARG is < 0." + (or arg (setq arg 1)) + (let ((forward-sexp-function nil) + (paren-regexp + (if (> arg 0) (python-rx close-paren) (python-rx open-paren))) + (search-fn + (if (> arg 0) #'re-search-forward #'re-search-backward))) + (condition-case nil + (forward-sexp arg) + (error + (while (and (funcall search-fn paren-regexp nil t) + (python-syntax-context 'paren))))))) + +(defun python-nav--forward-sexp () + "Move to forward sexp." + (case (python-syntax-context-type) + (string + ;; Inside of a string, get out of it. + (while (and (re-search-forward "[\"']" nil t) + (python-syntax-context 'string)))) + (comment + ;; Inside of a comment, just move forward. + (python-util-forward-comment)) + (paren + (python-nav-lisp-forward-sexp-safe 1)) + (t + (if (and (not (eobp)) + (= (syntax-class (syntax-after (point))) 4)) + ;; Looking an open-paren + (python-nav-lisp-forward-sexp-safe 1) + (let ((block-starting-pos + (save-excursion (python-nav-beginning-of-block))) + (block-ending-pos + (save-excursion (python-nav-end-of-block))) + (next-block-starting-pos + (save-excursion (python-nav-forward-block)))) + (cond + ((not block-starting-pos) + ;; Not inside a block, move to closest one. + (and next-block-starting-pos + (goto-char next-block-starting-pos))) + ((= (point) block-starting-pos) + ;; Point is at beginning of block + (if (and next-block-starting-pos + (< next-block-starting-pos block-ending-pos)) + ;; Beginning of next block is closer than current's + ;; end, move to it. + (goto-char next-block-starting-pos) + (goto-char block-ending-pos))) + ((= block-ending-pos (point)) + ;; Point is at end of current block + (let ((parent-block-end-pos + (save-excursion + (python-util-forward-comment) + (python-nav-beginning-of-block) + (python-nav-end-of-block)))) + (if (and parent-block-end-pos + (or (not next-block-starting-pos) + (> next-block-starting-pos parent-block-end-pos))) + ;; If the parent block ends before next block + ;; starts move to it. + (goto-char parent-block-end-pos) + (and next-block-starting-pos + (goto-char next-block-starting-pos))))) + (t (python-nav-end-of-block)))))))) + +(defun python-nav--backward-sexp () + "Move to backward sexp." + (case (python-syntax-context-type) + (string + ;; Inside of a string, get out of it. + (while (and (re-search-backward "[\"']" nil t) + (python-syntax-context 'string)))) + (comment + ;; Inside of a comment, just move backward. + (python-util-forward-comment -1)) + (paren + ;; Handle parens like we are lisp. + (python-nav-lisp-forward-sexp-safe -1)) + (t + (let* ((block-starting-pos + (save-excursion (python-nav-beginning-of-block))) + (block-ending-pos + (save-excursion (python-nav-end-of-block))) + (prev-block-ending-pos + (save-excursion (when (python-nav-backward-block) + (python-nav-end-of-block)))) + (prev-block-parent-ending-pos + (save-excursion + (when prev-block-ending-pos + (goto-char prev-block-ending-pos) + (python-util-forward-comment) + (python-nav-beginning-of-block) + (python-nav-end-of-block))))) + (if (and (not (bobp)) + (= (syntax-class (syntax-after (1- (point)))) 5)) + ;; Char before point is a paren closing char, handle it + ;; like we are lisp. + (python-nav-lisp-forward-sexp-safe -1) + (cond + ((not block-ending-pos) + ;; Not in and ending pos, move to end of previous block. + (and (python-nav-backward-block) + (python-nav-end-of-block))) + ((= (point) block-ending-pos) + ;; In ending pos, we need to search backwards for the + ;; closest point looking the list of candidates from here. + (let ((candidates)) + (dolist (name + '(prev-block-parent-ending-pos + prev-block-ending-pos + block-ending-pos + block-starting-pos)) + (when (and (symbol-value name) + (< (symbol-value name) (point))) + (add-to-list 'candidates (symbol-value name)))) + (goto-char (apply 'max candidates)))) + ((> (point) block-ending-pos) + ;; After an ending position, move to it. + (goto-char block-ending-pos)) + ((= (point) block-starting-pos) + ;; On a block starting position. + (if (not (> (point) (or prev-block-ending-pos (point)))) + ;; Point is after the end position of the block that + ;; wraps the current one, just move a block backward. + (python-nav-backward-block) + ;; If we got here we are facing a case like this one: + ;; + ;; try: + ;; return here() + ;; except Exception as e: + ;; + ;; Where point is on the "except" and must move to the + ;; end of "here()". + (goto-char prev-block-ending-pos) + (let ((parent-block-ending-pos + (save-excursion + (python-nav-forward-sexp) + (and (not (looking-at (python-rx block-start))) + (point))))) + (when (and parent-block-ending-pos + (> parent-block-ending-pos prev-block-ending-pos)) + ;; If we got here we are facing a case like this one: + ;; + ;; except ImportError: + ;; if predicate(): + ;; processing() + ;; here() + ;; except AttributeError: + ;; + ;; Where point is on the "except" and must move to + ;; the end of "here()". Without this extra step we'd + ;; just get to the end of processing(). + (goto-char parent-block-ending-pos))))) + (t + (if (and prev-block-ending-pos (< prev-block-ending-pos (point))) + (goto-char prev-block-ending-pos) + (python-nav-beginning-of-block))))))))) + +(defun python-nav-forward-sexp (&optional arg) "Move forward across one block of code. With ARG, do it that many times. Negative arg -N means move backward N times." (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) - (let ((block-starting-pos - (save-excursion (python-nav-beginning-of-block))) - (block-ending-pos - (save-excursion (python-nav-end-of-block))) - (next-block-starting-pos - (save-excursion (python-nav-forward-block)))) - (cond ((not block-starting-pos) - (python-nav-forward-block)) - ((= (point) block-starting-pos) - (if (or (not next-block-starting-pos) - (< block-ending-pos next-block-starting-pos)) - (python-nav-end-of-block) - (python-nav-forward-block))) - ((= block-ending-pos (point)) - (let ((parent-block-end-pos - (save-excursion - (python-util-forward-comment) - (python-nav-beginning-of-block) - (python-nav-end-of-block)))) - (if (and parent-block-end-pos - (or (not next-block-starting-pos) - (> next-block-starting-pos parent-block-end-pos))) - (goto-char parent-block-end-pos) - (python-nav-forward-block)))) - (t (python-nav-end-of-block)))) - (setq arg (1- arg))) + (python-nav--forward-sexp) + (setq arg (1- arg))) (while (< arg 0) - (let* ((block-starting-pos - (save-excursion (python-nav-beginning-of-block))) - (block-ending-pos - (save-excursion (python-nav-end-of-block))) - (prev-block-ending-pos - (save-excursion (when (python-nav-backward-block) - (python-nav-end-of-block)))) - (prev-block-parent-ending-pos - (save-excursion - (when prev-block-ending-pos - (goto-char prev-block-ending-pos) - (python-util-forward-comment) - (python-nav-beginning-of-block) - (python-nav-end-of-block))))) - (cond ((not block-ending-pos) - (and (python-nav-backward-block) - (python-nav-end-of-block))) - ((= (point) block-ending-pos) - (let ((candidates)) - (dolist (name - '(prev-block-parent-ending-pos - prev-block-ending-pos - block-ending-pos - block-starting-pos)) - (when (and (symbol-value name) - (< (symbol-value name) (point))) - (add-to-list 'candidates (symbol-value name)))) - (goto-char (apply 'max candidates)))) - ((> (point) block-ending-pos) - (python-nav-end-of-block)) - ((= (point) block-starting-pos) - (if (not (> (point) (or prev-block-ending-pos (point)))) - (python-nav-backward-block) - (goto-char prev-block-ending-pos) - (let ((parent-block-ending-pos - (save-excursion - (python-nav-forward-sexp-function) - (and (not (looking-at (python-rx block-start))) - (point))))) - (when (and parent-block-ending-pos - (> parent-block-ending-pos prev-block-ending-pos)) - (goto-char parent-block-ending-pos))))) - (t (python-nav-beginning-of-block)))) + (python-nav--backward-sexp) (setq arg (1+ arg)))) @@ -1420,16 +1549,12 @@ virtualenv." If DEDICATED is t and the variable `buffer-file-name' is non-nil returns a string with the form `python-shell-buffer-name'[variable `buffer-file-name'] else -returns the value of `python-shell-buffer-name'. After -calculating the process name adds the buffer name for the process -in the `same-window-buffer-names' list." +returns the value of `python-shell-buffer-name'." (let ((process-name (if (and dedicated buffer-file-name) (format "%s[%s]" python-shell-buffer-name buffer-file-name) (format "%s" python-shell-buffer-name)))) - (add-to-list 'same-window-buffer-names (purecopy - (format "*%s*" process-name))) process-name)) (defun python-shell-internal-get-process-name () @@ -1539,6 +1664,9 @@ variable. 'python-shell-completion-complete-at-point) (define-key inferior-python-mode-map "\t" 'python-shell-completion-complete-or-indent) + (make-local-variable 'python-pdbtrack-buffers-to-kill) + (make-local-variable 'python-pdbtrack-tracked-buffer) + (make-local-variable 'python-shell-internal-last-output) (when python-shell-enable-font-lock (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil)) @@ -1546,26 +1674,34 @@ variable. python-syntax-propertize-function)) (compilation-shell-minor-mode 1)) -(defun python-shell-make-comint (cmd proc-name &optional pop) +(defun python-shell-make-comint (cmd proc-name &optional pop internal) "Create a python shell comint buffer. CMD is the python command to be executed and PROC-NAME is the process name the comint buffer will get. After the comint buffer -is created the `inferior-python-mode' is activated. If POP is -non-nil the buffer is shown." +is created the `inferior-python-mode' is activated. When +optional argument POP is non-nil the buffer is shown. When +optional argument INTERNAL is non-nil this process is run on a +buffer with a name that starts with a space, following the Emacs +convention for temporary/internal buffers, and also makes sure +the user is not queried for confirmation when the process is +killed." (save-excursion - (let* ((proc-buffer-name (format "*%s*" proc-name)) + (let* ((proc-buffer-name + (format (if (not internal) "*%s*" " *%s*") proc-name)) (process-environment (python-shell-calculate-process-environment)) (exec-path (python-shell-calculate-exec-path))) (when (not (comint-check-proc proc-buffer-name)) (let* ((cmdlist (split-string-and-unquote cmd)) - (buffer (apply 'make-comint proc-name (car cmdlist) nil - (cdr cmdlist))) - (current-buffer (current-buffer))) + (buffer (apply #'make-comint-in-buffer proc-name proc-buffer-name + (car cmdlist) nil (cdr cmdlist))) + (current-buffer (current-buffer)) + (process (get-buffer-process buffer))) (with-current-buffer buffer (inferior-python-mode) (python-util-clone-local-variables current-buffer)) - (accept-process-output (get-buffer-process buffer)))) - (and pop (pop-to-buffer proc-buffer-name t)) + (accept-process-output process) + (and pop (pop-to-buffer buffer t)) + (and internal (set-process-query-on-exit-flag process nil)))) proc-buffer-name))) ;;;###autoload @@ -1611,11 +1747,10 @@ are set to nil for these shells, so setup codes are not sent at startup." (let ((python-shell-enable-font-lock nil) (inferior-python-mode-hook nil)) - (set-process-query-on-exit-flag - (get-buffer-process - (python-shell-make-comint - (python-shell-parse-command) - (python-shell-internal-get-process-name))) nil))) + (get-buffer-process + (python-shell-make-comint + (python-shell-parse-command) + (python-shell-internal-get-process-name) nil t)))) (defun python-shell-get-process () "Get inferior Python process for current buffer and return it." @@ -1651,18 +1786,16 @@ startup." "Current internal shell buffer for the current buffer. This is really not necessary at all for the code to work but it's there for compatibility with CEDET.") -(make-variable-buffer-local 'python-shell-internal-buffer) (defvar python-shell-internal-last-output nil "Last output captured by the internal shell. This is really not necessary at all for the code to work but it's there for compatibility with CEDET.") -(make-variable-buffer-local 'python-shell-internal-last-output) (defun python-shell-internal-get-or-create-process () "Get or create an inferior Internal Python process." (let* ((proc-name (python-shell-internal-get-process-name)) - (proc-buffer-name (format "*%s*" proc-name))) + (proc-buffer-name (format " *%s*" proc-name))) (when (not (process-live-p proc-name)) (run-python-internal) (setq python-shell-internal-buffer proc-buffer-name) @@ -1675,13 +1808,13 @@ there for compatibility with CEDET.") (get-buffer-process proc-buffer-name))) (define-obsolete-function-alias - 'python-proc 'python-shell-internal-get-or-create-process "24.2") + 'python-proc 'python-shell-internal-get-or-create-process "24.3") (define-obsolete-variable-alias - 'python-buffer 'python-shell-internal-buffer "24.2") + 'python-buffer 'python-shell-internal-buffer "24.3") (define-obsolete-variable-alias - 'python-preoutput-result 'python-shell-internal-last-output "24.2") + 'python-preoutput-result 'python-shell-internal-last-output "24.3") (defun python-shell-send-string (string &optional process msg) "Send STRING to inferior Python PROCESS. @@ -1689,8 +1822,7 @@ When MSG is non-nil messages the first line of STRING." (interactive "sPython command: ") (let ((process (or process (python-shell-get-or-create-process))) (lines (split-string string "\n" t))) - (when msg - (message (format "Sent: %s..." (nth 0 lines)))) + (and msg (message "Sent: %s..." (nth 0 lines))) (if (> (length lines) 1) (let* ((temp-file-name (make-temp-file "py")) (file-name (or (buffer-file-name) temp-file-name))) @@ -1744,10 +1876,10 @@ Returns the output. See `python-shell-send-string-no-output'." (python-shell-internal-get-or-create-process) nil))) (define-obsolete-function-alias - 'python-send-receive 'python-shell-internal-send-string "24.2") + 'python-send-receive 'python-shell-internal-send-string "24.3") (define-obsolete-function-alias - 'python-send-string 'python-shell-internal-send-string "24.2") + 'python-send-string 'python-shell-internal-send-string "24.3") (defun python-shell-send-region (start end) "Send the region delimited by START and END to inferior Python process." @@ -1820,11 +1952,10 @@ FILE-NAME." "Send all setup code for shell. This function takes the list of setup code to send from the `python-shell-setup-codes' list." - (let ((msg "Sent %s") - (process (get-buffer-process (current-buffer)))) + (let ((process (get-buffer-process (current-buffer)))) (dolist (code python-shell-setup-codes) (when code - (message (format msg code)) + (message "Sent %s" code) (python-shell-send-string (symbol-value code) process))))) @@ -1885,27 +2016,71 @@ and use the following as the value of this variable: :type 'string :group 'python) -(defun python-shell-completion--get-completions (input process completion-code) - "Retrieve available completions for INPUT using PROCESS. -Argument COMPLETION-CODE is the python code used to get -completions on the current context." - (with-current-buffer (process-buffer process) - (let ((completions (python-shell-send-string-no-output - (format completion-code input) process))) - (when (> (length completions) 2) - (split-string completions "^'\\|^\"\\|;\\|'$\\|\"$" t))))) +(defun python-shell-completion-get-completions (process line input) + "Do completion at point for PROCESS. +LINE is used to detect the context on how to complete given +INPUT." + (let* ((prompt + ;; Get the last prompt for the inferior process + ;; buffer. This is used for the completion code selection + ;; heuristic. + (with-current-buffer (process-buffer process) + (buffer-substring-no-properties + (overlay-start comint-last-prompt-overlay) + (overlay-end comint-last-prompt-overlay)))) + (completion-context + ;; Check whether a prompt matches a pdb string, an import + ;; statement or just the standard prompt and use the + ;; correct python-shell-completion-*-code string + (cond ((and (> (length python-shell-completion-pdb-string-code) 0) + (string-match + (concat "^" python-shell-prompt-pdb-regexp) prompt)) + 'pdb) + ((and (> + (length python-shell-completion-module-string-code) 0) + (string-match + (concat "^" python-shell-prompt-regexp) prompt) + (string-match "^[ \t]*\\(from\\|import\\)[ \t]" line)) + 'import) + ((string-match + (concat "^" python-shell-prompt-regexp) prompt) + 'default) + (t nil))) + (completion-code + (case completion-context + (pdb python-shell-completion-pdb-string-code) + (import python-shell-completion-module-string-code) + (default python-shell-completion-string-code) + (t nil))) + (input + (if (eq completion-context 'import) + (replace-regexp-in-string "^[ \t]+" "" line) + input))) + (and completion-code + (> (length input) 0) + (with-current-buffer (process-buffer process) + (let ((completions (python-shell-send-string-no-output + (format completion-code input) process))) + (and (> (length completions) 2) + (split-string completions + "^'\\|^\"\\|;\\|'$\\|\"$" t))))))) -(defun python-shell-completion--do-completion-at-point (process) - "Do completion at point for PROCESS." - (with-syntax-table python-dotty-syntax-table - (let* ((beg - (save-excursion +(defun python-shell-completion-complete-at-point (&optional process) + "Perform completion at point in inferior Python. +Optional argument PROCESS forces completions to be retrieved +using that one instead of current buffer's process." + (setq process (or process (get-buffer-process (current-buffer)))) + (let* ((start + (save-excursion + (with-syntax-table python-dotty-syntax-table (let* ((paren-depth (car (syntax-ppss))) (syntax-string "w_") (syntax-list (string-to-syntax syntax-string))) - ;; Stop scanning for the beginning of the completion subject - ;; after the char before point matches a delimiter - (while (member (car (syntax-after (1- (point)))) syntax-list) + ;; Stop scanning for the beginning of the completion + ;; subject after the char before point matches a + ;; delimiter + (while (member + (car (syntax-after (1- (point)))) syntax-list) (skip-syntax-backward syntax-string) (when (or (equal (char-before) ?\)) (equal (char-before) ?\")) @@ -1913,59 +2088,16 @@ completions on the current context." (while (or ;; honor initial paren depth (> (car (syntax-ppss)) paren-depth) - (python-info-ppss-context 'string)) - (forward-char -1)))) - (point))) - (end (point)) - (line (buffer-substring-no-properties (point-at-bol) end)) - (input (buffer-substring-no-properties beg end)) - ;; Get the last prompt for the inferior process buffer. This is - ;; used for the completion code selection heuristic. - (prompt - (with-current-buffer (process-buffer process) - (buffer-substring-no-properties - (overlay-start comint-last-prompt-overlay) - (overlay-end comint-last-prompt-overlay)))) - (completion-context - ;; Check whether a prompt matches a pdb string, an import statement - ;; or just the standard prompt and use the correct - ;; python-shell-completion-*-code string - (cond ((and (> (length python-shell-completion-pdb-string-code) 0) - (string-match - (concat "^" python-shell-prompt-pdb-regexp) prompt)) - 'pdb) - ((and (> - (length python-shell-completion-module-string-code) 0) - (string-match - (concat "^" python-shell-prompt-regexp) prompt) - (string-match "^[ \t]*\\(from\\|import\\)[ \t]" line)) - 'import) - ((string-match - (concat "^" python-shell-prompt-regexp) prompt) - 'default) - (t nil))) - (completion-code - (case completion-context - ('pdb python-shell-completion-pdb-string-code) - ('import python-shell-completion-module-string-code) - ('default python-shell-completion-string-code) - (t nil))) - (input - (if (eq completion-context 'import) - (replace-regexp-in-string "^[ \t]+" "" line) - input)) - (completions - (and completion-code (> (length input) 0) - (python-shell-completion--get-completions - input process completion-code)))) - (list beg end completions)))) - -(defun python-shell-completion-complete-at-point () - "Perform completion at point in inferior Python process." - (and comint-last-prompt-overlay - (> (point-marker) (overlay-end comint-last-prompt-overlay)) - (python-shell-completion--do-completion-at-point - (get-buffer-process (current-buffer))))) + (python-syntax-context 'string)) + (forward-char -1))) + (point))))) + (end (point))) + (list start end + (completion-table-dynamic + (apply-partially + #'python-shell-completion-get-completions + process (buffer-substring-no-properties + (line-beginning-position) end)))))) (defun python-shell-completion-complete-or-indent () "Complete or indent depending on the context. @@ -1999,11 +2131,9 @@ Used to extract the current line and module being inspected." "Variable containing the value of the current tracked buffer. Never set this variable directly, use `python-pdbtrack-set-tracked-buffer' instead.") -(make-variable-buffer-local 'python-pdbtrack-tracked-buffer) (defvar python-pdbtrack-buffers-to-kill nil "List of buffers to be deleted after tracking finishes.") -(make-variable-buffer-local 'python-pdbtrack-buffers-to-kill) (defun python-pdbtrack-set-tracked-buffer (file-name) "Set the buffer for FILE-NAME as the tracked buffer. @@ -2079,7 +2209,7 @@ inferior python process is updated properly." (let ((process (python-shell-get-process))) (if (not process) (error "Completion needs an inferior Python process running") - (python-shell-completion--do-completion-at-point process)))) + (python-shell-completion-complete-at-point process)))) (add-to-list 'debug-ignored-errors "^Completion needs an inferior Python process running.") @@ -2133,7 +2263,7 @@ Optional argument JUSTIFY defines if the paragraph should be justified." ((funcall python-fill-comment-function justify)) ;; Strings/Docstrings ((save-excursion (skip-chars-forward "\"'uUrR") - (python-info-ppss-context 'string)) + (python-syntax-context 'string)) (funcall python-fill-string-function justify)) ;; Decorators ((equal (char-after (save-excursion @@ -2141,7 +2271,7 @@ Optional argument JUSTIFY defines if the paragraph should be justified." (point-marker))) ?@) (funcall python-fill-decorator-function justify)) ;; Parens - ((or (python-info-ppss-context 'paren) + ((or (python-syntax-context 'paren) (looking-at (python-rx open-paren)) (save-excursion (skip-syntax-forward "^(" (line-end-position)) @@ -2161,13 +2291,13 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." (string-start-marker (progn (skip-chars-forward "\"'uUrR") - (goto-char (python-info-ppss-context 'string)) + (goto-char (python-syntax-context 'string)) (skip-chars-forward "\"'uUrR") (point-marker))) (reg-start (line-beginning-position)) (string-end-marker (progn - (while (python-info-ppss-context 'string) + (while (python-syntax-context 'string) (goto-char (1+ (point-marker)))) (skip-chars-backward "\"'") (point-marker))) @@ -2205,16 +2335,16 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." JUSTIFY should be used (if applicable) as in `fill-paragraph'." (save-restriction (narrow-to-region (progn - (while (python-info-ppss-context 'paren) + (while (python-syntax-context 'paren) (goto-char (1- (point-marker)))) (point-marker) (line-beginning-position)) (progn - (when (not (python-info-ppss-context 'paren)) + (when (not (python-syntax-context 'paren)) (end-of-line) - (when (not (python-info-ppss-context 'paren)) + (when (not (python-syntax-context 'paren)) (skip-syntax-backward "^)"))) - (while (python-info-ppss-context 'paren) + (while (python-syntax-context 'paren) (goto-char (1+ (point-marker)))) (point-marker))) (let ((paragraph-start "\f\\|[ \t]*$") @@ -2239,7 +2369,7 @@ the if condition." :safe 'booleanp) (define-obsolete-variable-alias - 'python-use-skeletons 'python-skeleton-autoinsert "24.2") + 'python-use-skeletons 'python-skeleton-autoinsert "24.3") (defvar python-skeleton-available '() "Internal list of available skeletons.") @@ -2252,7 +2382,7 @@ the if condition." ;; Only expand in code. :enable-function (lambda () (and - (not (python-info-ppss-comment-or-string-p)) + (not (python-syntax-comment-or-string-p)) python-skeleton-autoinsert))) (defmacro python-skeleton-define (name doc &rest skel) @@ -2572,7 +2702,7 @@ not inside a defun." With optional argument REPLACE-SELF convert \"self\" to current parent defun name." (let ((name - (and (not (python-info-ppss-comment-or-string-p)) + (and (not (python-syntax-comment-or-string-p)) (with-syntax-table python-dotty-syntax-table (let ((sym (symbol-at-point))) (and sym @@ -2650,7 +2780,7 @@ With optional argument LINE-NUMBER, check that line instead." (goto-char line-number)) (while (and (not (eobp)) (goto-char (line-end-position)) - (python-info-ppss-context 'paren) + (python-syntax-context 'paren) (not (equal (char-before (point)) ?\\))) (forward-line 1)) (when (equal (char-before) ?\\) @@ -2667,7 +2797,7 @@ Optional argument LINE-NUMBER forces the line number to check against." (when (python-info-line-ends-backslash-p) (while (save-excursion (goto-char (line-beginning-position)) - (python-info-ppss-context 'paren)) + (python-syntax-context 'paren)) (forward-line -1)) (back-to-indentation) (point-marker))))) @@ -2681,10 +2811,10 @@ where the continued line ends." (widen) (let* ((context-type (progn (back-to-indentation) - (python-info-ppss-context-type))) + (python-syntax-context-type))) (line-start (line-number-at-pos)) (context-start (when context-type - (python-info-ppss-context context-type)))) + (python-syntax-context context-type)))) (cond ((equal context-type 'paren) ;; Lines inside a paren are always a continuation line ;; (except the first one). @@ -2729,41 +2859,13 @@ operator." assignment-operator not-simple-operator) (line-end-position) t) - (not (python-info-ppss-context-type)))) + (not (python-syntax-context-type)))) (skip-syntax-forward "\s") (point-marker))))) -(defun python-info-ppss-context (type &optional syntax-ppss) - "Return non-nil if point is on TYPE using SYNTAX-PPSS. -TYPE can be `comment', `string' or `paren'. It returns the start -character address of the specified TYPE." - (let ((ppss (or syntax-ppss (syntax-ppss)))) - (case type - (comment - (and (nth 4 ppss) - (nth 8 ppss))) - (string - (and (not (nth 4 ppss)) - (nth 8 ppss))) - (paren - (nth 1 ppss)) - (t nil)))) - -(defun python-info-ppss-context-type (&optional syntax-ppss) - "Return the context type using SYNTAX-PPSS. -The type returned can be `comment', `string' or `paren'." - (let ((ppss (or syntax-ppss (syntax-ppss)))) - (cond - ((nth 8 ppss) (if (nth 4 ppss) 'comment 'string)) - ((nth 1 ppss) 'paren)))) - -(defsubst python-info-ppss-comment-or-string-p () - "Return non-nil if point is inside 'comment or 'string." - (nth 8 (syntax-ppss))) - (defun python-info-looking-at-beginning-of-defun (&optional syntax-ppss) "Check if point is at `beginning-of-defun' using SYNTAX-PPSS." - (and (not (python-info-ppss-context-type (or syntax-ppss (syntax-ppss)))) + (and (not (python-syntax-context-type (or syntax-ppss (syntax-ppss)))) (save-excursion (beginning-of-line 1) (looking-at python-nav-beginning-of-defun-regexp)))) @@ -2809,7 +2911,7 @@ to \"^python-\"." (defun python-util-forward-comment (&optional direction) "Python mode specific version of `forward-comment'. Optional argument DIRECTION defines the direction to move to." - (let ((comment-start (python-info-ppss-context 'comment)) + (let ((comment-start (python-syntax-context 'comment)) (factor (if (< (or direction 0) 0) -99999 99999))) @@ -2835,7 +2937,7 @@ if that value is non-nil." (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'forward-sexp-function) - 'python-nav-forward-sexp-function) + 'python-nav-forward-sexp) (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil)) @@ -2896,6 +2998,8 @@ if that value is non-nil." (python-skeleton-add-menu-items) + (make-local-variable 'python-shell-internal-buffer) + (when python-indent-guess-indent-offset (python-indent-guess-indent-offset))) diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 091a7b74df2..457c7fee36c 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -150,8 +150,7 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (define-key map (kbd "M-C-q") 'ruby-indent-exp) (define-key map (kbd "C-M-h") 'backward-kill-word) (define-key map (kbd "C-j") 'reindent-then-newline-and-indent) - (define-key map (kbd "C-m") 'newline) - (define-key map (kbd "C-c C-c") 'comment-region) + (define-key map (kbd "C-c {") 'ruby-toggle-block) map) "Keymap used in Ruby mode.") @@ -380,11 +379,19 @@ and `\\' when preceded by `?'." ((and (eq c ?:) (or (not b) (eq (char-syntax b) ? )))) ((eq c ?\\) (eq b ??))))) +(defun ruby-singleton-class-p (&optional pos) + (save-excursion + (when pos (goto-char pos)) + (forward-word -1) + (and (or (bolp) (not (eq (char-before (point)) ?_))) + (looking-at "class\\s *<<")))) + (defun ruby-expr-beg (&optional option) "TODO: document." (save-excursion (store-match-data nil) - (let ((space (skip-chars-backward " \t"))) + (let ((space (skip-chars-backward " \t")) + (start (point))) (cond ((bolp) t) ((progn @@ -393,7 +400,8 @@ and `\\' when preceded by `?'." (or (eq (char-syntax (char-before (point))) ?w) (ruby-special-char-p)))) nil) - ((and (eq option 'heredoc) (< space 0)) t) + ((and (eq option 'heredoc) (< space 0)) + (not (progn (goto-char start) (ruby-singleton-class-p)))) ((or (looking-at ruby-operator-re) (looking-at "[\\[({,;]") (and (looking-at "[!?]") @@ -409,7 +417,7 @@ and `\\' when preceded by `?'." ruby-block-mid-keywords) 'words)) (goto-char (match-end 0)) - (not (looking-at "\\s_"))) + (not (looking-at "\\s_\\|!"))) ((eq option 'expr-qstr) (looking-at "[a-zA-Z][a-zA-z0-9_]* +%[^ \t]")) ((eq option 'expr-re) @@ -581,9 +589,7 @@ and `\\' when preceded by `?'." (eq ?. w))))) (goto-char pnt) (setq w (char-after (point))) - (not (eq ?_ w)) (not (eq ?! w)) - (not (eq ?? w)) (skip-chars-forward " \t") (goto-char (match-beginning 0)) (or (not (looking-at ruby-modifier-re)) @@ -794,7 +800,7 @@ and `\\' when preceded by `?'." ;; (not (or (eolp) (looking-at "#") ;; (and (eq (car (nth 1 state)) ?{) ;; (looking-at "|")))))) - ;; Not a regexp or general delimited literal. + ;; Not a regexp or percent literal. (null (nth 0 (ruby-parse-region (or begin parse-start) (point)))) (or (not (eq ?| (char-after (point)))) @@ -875,10 +881,11 @@ or blocks containing the current block." ;; TODO: Make this work for n > 1, ;; make it not loop for n = 0, ;; document body - (let (start pos done down) - (setq start (ruby-calculate-indent)) - (setq down (looking-at (if (< n 0) ruby-block-end-re - (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) + (let ((orig (point)) + (start (ruby-calculate-indent)) + (down (looking-at (if (< n 0) ruby-block-end-re + (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) + pos done) (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) (forward-line n) (cond @@ -901,8 +908,18 @@ or blocks containing the current block." (save-excursion (back-to-indentation) (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) - (setq done nil)))))) - (back-to-indentation)) + (setq done nil))))) + (back-to-indentation) + (when (< n 0) + (let ((eol (point-at-eol)) state next) + (if (< orig eol) (setq eol orig)) + (setq orig (point)) + (while (and (setq next (apply 'ruby-parse-partial eol state)) + (< (point) eol)) + (setq state next)) + (when (cdaadr state) + (goto-char (cdaadr state))) + (backward-word))))) (defun ruby-beginning-of-block (&optional arg) "Move backward to the beginning of the current block. @@ -1110,18 +1127,70 @@ See `add-log-current-defun-function'." (if mlist (concat mlist mname) mname) mlist))))) +(defun ruby-brace-to-do-end () + (when (looking-at "{") + (let ((orig (point)) (end (progn (ruby-forward-sexp) (point)))) + (when (eq (char-before) ?\}) + (delete-char -1) + (if (eq (char-syntax (char-before)) ?w) + (insert " ")) + (insert "end") + (if (eq (char-syntax (char-after)) ?w) + (insert " ")) + (goto-char orig) + (delete-char 1) + (if (eq (char-syntax (char-before)) ?w) + (insert " ")) + (insert "do") + (when (looking-at "\\sw\\||") + (insert " ") + (backward-char)) + t)))) + +(defun ruby-do-end-to-brace () + (when (and (or (bolp) + (not (memq (char-syntax (char-before)) '(?w ?_)))) + (looking-at "\\]\\|\\(?:^\\|\\s \\)" + "\\(^\\|[[=(,~?:;<>]" + ;; Control flow keywords and operators following bol or whitespace. + "\\|\\(?:^\\|\\s \\)" (regexp-opt '("if" "elsif" "unless" "while" "until" "when" "and" - "or" "&&" "||" - "gsub" "gsub!" "sub" "sub!" "scan" "split" "split!")) - "\\)\\s *\\)?" + "or" "not" "&&" "||")) + ;; Method name from the list. + "\\|\\_<" + (regexp-opt ruby-syntax-methods-before-regexp) + "\\)\\s *" ;; The regular expression itself. - "\\(/\\)[^/\n\\\\]*\\(?:\\\\.[^/\n\\\\]*\\)*\\(/\\)" - ;; Special code that cannot follow a division operator. - ;; FIXME: Just because the second slash of "/foo/ do bar" can't - ;; be a division, doesn't mean it can't *start* a regexp, as in - ;; "x = toto/foo; if /do bar/". - "\\([imxo]*\\s *\\(?:,\\|\\_\\)\\)?") - (2 (when (or (match-beginning 1) (match-beginning 4)) - (string-to-syntax "\"/"))) - (3 (if (or (match-beginning 1) (match-beginning 4)) - (string-to-syntax "\"/") - (goto-char (match-end 2))))) + "\\(/\\)[^/\n\\\\]*\\(?:\\\\.[^/\n\\\\]*\\)*\\(/\\)") + (2 (string-to-syntax "\"/")) + (3 (string-to-syntax "\"/"))) ("^=en\\(d\\)\\_>" (1 "!")) ("^\\(=\\)begin\\_>" (1 "!")) ;; Handle here documents. ((concat ruby-here-doc-beg-re ".*\\(\n\\)") - (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))) + (7 (unless (ruby-singleton-class-p (match-beginning 0)) + (put-text-property (match-beginning 7) (match-end 7) + 'syntax-table (string-to-syntax "\"")) + (ruby-syntax-propertize-heredoc end)))) ;; Handle percent literals: %w(), %q{}, etc. - ("\\(?:^\\|[[ \t\n<+(,=]\\)\\(%\\)[qQrswWx]?\\([[:punct:]]\\)" - (1 (prog1 "|" (ruby-syntax-propertize-general-delimiters end))))) + ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) + (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) (point) end)) (defun ruby-syntax-propertize-heredoc (limit) @@ -1174,7 +1241,8 @@ See `add-log-current-defun-function'." (beginning-of-line) (while (re-search-forward ruby-here-doc-beg-re (line-end-position) t) - (push (concat (ruby-here-doc-end-match) "\n") res))) + (unless (ruby-singleton-class-p (match-beginning 0)) + (push (concat (ruby-here-doc-end-match) "\n") res)))) (let ((start (point))) ;; With multiple openers on the same line, we don't know in which ;; part `start' is, so we have to go back to the beginning. @@ -1189,40 +1257,46 @@ See `add-log-current-defun-function'." ;; inf-loop. (if (< (point) start) (goto-char start)))))) - (defun ruby-syntax-general-delimiters-goto-beg () - (let ((state (syntax-ppss))) - ;; Move to the start of the literal, in case it's multiline. - ;; TODO: determine the literal type more reliably here? + (defun ruby-syntax-enclosing-percent-literal (limit) + (let ((state (syntax-ppss)) + (start (point))) + ;; When already inside percent literal, re-propertize it. (when (eq t (nth 3 state)) (goto-char (nth 8 state)) - (beginning-of-line)))) + (when (looking-at ruby-percent-literal-beg-re) + (ruby-syntax-propertize-percent-literal limit)) + (when (< (point) start) (goto-char start))))) - (defun ruby-syntax-propertize-general-delimiters (limit) + (defun ruby-syntax-propertize-percent-literal (limit) (goto-char (match-beginning 2)) - (let* ((op (char-after)) - (ops (char-to-string op)) - (cl (or (cdr (aref (syntax-table) op)) - (cdr (assoc op '((?< . ?>)))))) - parse-sexp-lookup-properties) - (ignore-errors - (if cl - (progn ; Paired delimiters. - ;; Delimiter pairs of the same kind can be nested - ;; inside the literal, as long as they are balanced. - ;; Create syntax table that ignores other characters. - (with-syntax-table (make-char-table 'syntax-table nil) - (modify-syntax-entry op (concat "(" (char-to-string cl))) - (modify-syntax-entry cl (concat ")" ops)) - (modify-syntax-entry ?\\ "\\") - (save-restriction - (narrow-to-region (point) limit) - (forward-list)))) ; skip to the paired character - ;; Single character delimiter. - (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" - (regexp-quote ops)) limit nil)) - ;; If we reached here, the closing delimiter was found. - (put-text-property (1- (point)) (point) - 'syntax-table (string-to-syntax "|"))))) + ;; Not inside a simple string or comment. + (when (eq t (nth 3 (syntax-ppss))) + (let* ((op (char-after)) + (ops (char-to-string op)) + (cl (or (cdr (aref (syntax-table) op)) + (cdr (assoc op '((?< . ?>)))))) + parse-sexp-lookup-properties) + (condition-case nil + (progn + (if cl ; Paired delimiters. + ;; Delimiter pairs of the same kind can be nested + ;; inside the literal, as long as they are balanced. + ;; Create syntax table that ignores other characters. + (with-syntax-table (make-char-table 'syntax-table nil) + (modify-syntax-entry op (concat "(" (char-to-string cl))) + (modify-syntax-entry cl (concat ")" ops)) + (modify-syntax-entry ?\\ "\\") + (save-restriction + (narrow-to-region (point) limit) + (forward-list))) ; skip to the paired character + ;; Single character delimiter. + (re-search-forward (concat "[^\\]\\(?:\\\\\\\\\\)*" + (regexp-quote ops)) limit nil)) + ;; Found the closing delimiter. + (put-text-property (1- (point)) (point) 'syntax-table + (string-to-syntax "|"))) + ;; Unclosed literal, leave the following text unpropertized. + ((scan-error search-failed) (goto-char limit)))))) ) ;; For Emacsen where syntax-propertize-rules is not (yet) available, @@ -1267,7 +1341,7 @@ This should only be called after matching against `ruby-here-doc-end-re'." (4 (7 . ?/)) (6 (7 . ?/))) ("^=en\\(d\\)\\_>" 1 "!") - ;; General delimited string. + ;; Percent literal. ("\\(^\\|[[ \t\n<+(,=]\\)\\(%[xrqQwW]?\\([^<[{(a-zA-Z0-9 \n]\\)[^\n\\\\]*\\(\\\\.[^\n\\\\]*\\)*\\(\\3\\)\\)" (3 "\"") (5 "\"")) @@ -1310,7 +1384,8 @@ isn't in a string or another comment." (let ((old-point (point)) (case-fold-search nil)) (beginning-of-line) (catch 'found-beg - (while (re-search-backward ruby-here-doc-beg-re nil t) + (while (and (re-search-backward ruby-here-doc-beg-re nil t) + (not (ruby-singleton-class-p))) (if (not (or (ruby-in-ppss-context-p 'anything) (ruby-here-doc-find-end old-point))) (throw 'found-beg t))))))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index a713539cd8e..a6089aabb04 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -4076,7 +4076,7 @@ The document is bounded by `sh-here-document-word'." (self-insert-command (prefix-numeric-value arg)) (or arg (sh--maybe-here-document))) (make-obsolete 'sh--maybe-here-document - 'sh-electric-here-document-mode "24.2") + 'sh-electric-here-document-mode "24.3") (defun sh--maybe-here-document () (or (not (looking-back "[^<]<<")) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 02948b35fe0..02340425dfa 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -80,7 +80,7 @@ For other modes it is disabled. If this is equal to t, then Which Function mode is enabled in any major mode that supports it." :group 'which-func - :version "24.2" ; explicit list -> t + :version "24.3" ; explicit list -> t :type '(choice (const :tag "All modes" t) (repeat (symbol :tag "Major mode")))) @@ -150,7 +150,7 @@ mouse-2: toggle rest visibility\n\ mouse-3: go to end") "]") "Format for displaying the function in the mode line." - :version "24.2" ; added mouse-face + :version "24.2" ; added mouse-face; 24point2 is correct :group 'which-func :type 'sexp) ;;;###autoload (put 'which-func-format 'risky-local-variable t) diff --git a/lisp/replace.el b/lisp/replace.el index 5baf68224c4..3373ee8e512 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -912,7 +912,9 @@ To return to ordinary Occur mode, use \\[occur-cease-edit]." (line-number-at-pos (window-start)))) (readonly (with-current-buffer buf buffer-read-only)) (win (or (get-buffer-window buf) - (display-buffer buf t))) + (display-buffer buf + '(nil (inhibit-same-window . t) + (inhibit-switch-frame . t))))) (line-end (line-end-position)) (text (save-excursion (goto-char (next-single-property-change @@ -1140,8 +1142,8 @@ contain \\& and \\N which convention follows `replace-match'. For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and \"\\1\" for NLINES collects all the function names in a lisp program. When there is no parenthesized subexpressions in REGEXP -the entire match is collected. In any case the searched buffers -are not modified." +the entire match is collected. In any case the searched buffer +is not modified." (interactive (occur-read-primary-args)) (occur-1 regexp nlines (list (current-buffer)))) diff --git a/lisp/savehist.el b/lisp/savehist.el index 6310190b4fe..215314d7053 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -278,9 +278,9 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (print-level nil) (print-readably t) (print-quoted t)) - ;; During the 24.2 development, read-passwd had a bug which resulted in + ;; During the 24.3 development, read-passwd had a bug which resulted in ;; the passwords being saved by savehist. Trim them, retroactively. - ;; This code can be removed after the 24.2 release. + ;; This code can be removed after the 24.3 release. (dolist (sym savehist-minibuffer-history-variables) (if (and (symbolp sym) (equal (symbol-name sym) "forget-history")) (setq savehist-minibuffer-history-variables diff --git a/lisp/server.el b/lisp/server.el index a25da406571..6d34df351ca 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -163,7 +163,7 @@ key." :type '(choice (const :tag "Random" nil) (string :tag "Password")) - :version "24.2") + :version "24.3") (defcustom server-raise-frame t "If non-nil, raise frame when switching to a buffer." diff --git a/lisp/simple.el b/lisp/simple.el index e1d6760e72b..76243a202bc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -570,7 +570,7 @@ Trailing lines are deleted only if `delete-trailing-whitespace' is called on the entire buffer (rather than an active region)." :type 'boolean :group 'editing - :version "24.2") + :version "24.3") (defun delete-trailing-whitespace (&optional start end) "Delete trailing whitespace between START and END. @@ -966,16 +966,22 @@ rather than line counts." (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) -(defun count-words-region (start end) +(defun count-words-region (start end &optional arg) "Count the number of words in the region. If called interactively, print a message reporting the number of -lines, words, and chars in the region. +lines, words, and characters in the region (whether or not the +region is active); with prefix ARG, report for the entire buffer +rather than the region. + If called from Lisp, return the number of words between positions START and END." - (interactive "r") - (if (called-interactively-p 'any) - (count-words--message "Region" start end) - (count-words start end))) + (interactive "r\nP") + (cond ((not (called-interactively-p 'any)) + (count-words start end)) + (arg + (count-words--buffer-message)) + (t + (count-words--message "Region" start end)))) (defun count-words (start end) "Count words between START and END. @@ -999,11 +1005,14 @@ END, without printing any message." ((use-region-p) (call-interactively 'count-words-region)) (t - (count-words--message - (if (= (point-max) (1+ (buffer-size))) - "Buffer" - "Narrowed part of buffer") - (point-min) (point-max))))) + (count-words--buffer-message)))) + +(defun count-words--buffer-message () + (count-words--message + (if (= (point-max) (1+ (buffer-size))) + "Buffer" + "Narrowed part of buffer") + (point-min) (point-max))) (defun count-words--message (str start end) (let ((lines (count-lines start end)) @@ -2286,7 +2295,7 @@ output buffer and running a new command in the default buffer, (const :tag "Rename the existing buffer" rename-buffer)) :group 'shell - :version "24.2") + :version "24.3") (defun async-shell-command (command &optional output-buffer error-buffer) "Execute string COMMAND asynchronously in background. @@ -2881,7 +2890,9 @@ Also, delete any process that is exited or signaled." "network") (if (plist-get contact :server) (format "server on %s" - (plist-get contact :server)) + (or + (plist-get contact :host) + (plist-get contact :local))) (format "connection to %s" (plist-get contact :host)))) (format "(serial port %s%s)" @@ -2904,7 +2915,7 @@ the query-on-exit flag set are listed. Any process listed as exited or signaled is actually eliminated after the listing is made. Optional argument BUFFER specifies a buffer to use, instead of -\"*Process List\". +\"*Process List*\". The return value is always nil." (interactive) (or (fboundp 'process-list) @@ -3958,9 +3969,8 @@ run `deactivate-mark-hook'." (or (x-selection-owner-p 'PRIMARY) (null (x-selection-exists-p 'PRIMARY)))) (x-set-selection 'PRIMARY - (buffer-substring-no-properties - (region-beginning) - (region-end)))))) + (buffer-substring (region-beginning) + (region-end)))))) (if (and (null force) (or (eq transient-mark-mode 'lambda) (and (eq (car-safe transient-mark-mode) 'only) diff --git a/lisp/sort.el b/lisp/sort.el index 8cfe69f9458..44f90fff379 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -401,18 +401,23 @@ the sort order." ;;;###autoload (defun sort-regexp-fields (reverse record-regexp key-regexp beg end) - "Sort the region lexicographically as specified by RECORD-REGEXP and KEY. -RECORD-REGEXP specifies the textual units which should be sorted. - For example, to sort lines RECORD-REGEXP would be \"^.*$\" -KEY specifies the part of each record (ie each match for RECORD-REGEXP) - is to be used for sorting. - If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from - RECORD-REGEXP is used. - If it is \"\\\\&\" then the whole record is used. - Otherwise, it is a regular-expression for which to search within the record. -If a match for KEY is not found within a record then that record is ignored. + "Sort the text in the region region lexicographically. +If called interactively, prompt for two regular expressions, +RECORD-REGEXP and KEY-REGEXP. -With a negative prefix arg sorts in reverse order. +RECORD-REGEXP specifies the textual units to be sorted. + For example, to sort lines, RECORD-REGEXP would be \"^.*$\". + +KEY-REGEXP specifies the part of each record (i.e. each match for + RECORD-REGEXP) to be used for sorting. + If it is \"\\\\digit\", use the digit'th \"\\\\(...\\\\)\" + match field specified by RECORD-REGEXP. + If it is \"\\\\&\", use the whole record. + Otherwise, KEY-REGEXP should be a regular expression with which + to search within the record. If a match for KEY-REGEXP is not + found within a record, that record is ignored. + +With a negative prefix arg, sort in reverse order. The variable `sort-fold-case' determines whether alphabetic case affects the sort order. diff --git a/lisp/strokes.el b/lisp/strokes.el index 302e441d282..dfd0e95f61a 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -217,7 +217,7 @@ static char * stroke_xpm[] = { :type 'string :group 'strokes) -(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter "24.2") +(define-obsolete-variable-alias 'strokes-modeline-string 'strokes-lighter "24.3") (defcustom strokes-character ?@ "Character used when drawing strokes in the strokes buffer. diff --git a/lisp/subr.el b/lisp/subr.el index 73bc1d99e05..1e367a155d0 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -907,11 +907,12 @@ The normal global definition of the character C-x indirects to this keymap.") c))) key))) -(defsubst eventp (obj) +(defun eventp (obj) "True if the argument is an event object." - (or (integerp obj) - (and (symbolp obj) obj (not (keywordp obj))) - (and (consp obj) (symbolp (car obj))))) + (when obj + (or (integerp obj) + (and (symbolp obj) obj (not (keywordp obj))) + (and (consp obj) (symbolp (car obj)))))) (defun event-modifiers (event) "Return a list of symbols representing the modifier keys in event EVENT. @@ -975,7 +976,7 @@ in the current Emacs session, then this function may return nil." ;; is this really correct? maybe remove mouse-movement? (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))) -(defsubst event-start (event) +(defun event-start (event) "Return the starting position of EVENT. EVENT should be a click, drag, or key press event. If it is a key press event, the return value has the form @@ -990,9 +991,10 @@ If EVENT is a mouse or key press or a mouse click, this is the position of the event. If EVENT is a drag, this is the starting position of the drag." (if (consp event) (nth 1 event) - (list (selected-window) (point) '(0 . 0) 0))) + (or (posn-at-point) + (list (selected-window) (point) '(0 . 0) 0)))) -(defsubst event-end (event) +(defun event-end (event) "Return the ending location of EVENT. EVENT should be a click, drag, or key press event. If EVENT is a key press event, the return value has the form @@ -1009,7 +1011,8 @@ If EVENT is a mouse or key press or a mouse click, this is the position of the event. If EVENT is a drag, this is the starting position of the drag." (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) - (list (selected-window) (point) '(0 . 0) 0))) + (or (posn-at-point) + (list (selected-window) (point) '(0 . 0) 0)))) (defsubst event-click-count (event) "Return the multi-click count of EVENT, a click or drag event. @@ -1018,6 +1021,13 @@ The return value is a positive integer." ;;;; Extracting fields of the positions in an event. +(defun posnp (obj) + "Return non-nil if OBJ appears to be a valid `posn' object." + (and (windowp (car-safe obj)) + (atom (car-safe (setq obj (cdr obj)))) ;AREA-OR-POS. + (integerp (car-safe (car-safe (setq obj (cdr obj))))) ;XOFFSET. + (integerp (car-safe (cdr obj))))) ;TIMESTAMP. + (defsubst posn-window (position) "Return the window in POSITION. POSITION should be a list of the form returned by the `event-start' @@ -1159,7 +1169,7 @@ be a list of the form returned by `event-start' and `event-end'." (define-obsolete-function-alias 'string-to-int 'string-to-number "22.1") (make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") -(make-obsolete 'buffer-has-markers-at nil "24.2") +(make-obsolete 'buffer-has-markers-at nil "24.3") (defun insert-string (&rest args) "Mocklisp-compatibility insert function. @@ -1184,7 +1194,7 @@ is converted into a string by expressing it in decimal." (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") -(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.2") +(set-advertised-calling-convention 'redirect-frame-focus '(frame focus-frame) "24.3") ;;;; Obsolescence declarations for variables, and aliases. @@ -2172,7 +2182,8 @@ by doing (clear-string STRING)." (set (make-local-variable 'post-self-insert-hook) nil) (add-hook 'after-change-functions hide-chars-fun nil 'local)) (unwind-protect - (read-string prompt nil t default) ; t = "no history" + (let ((enable-recursive-minibuffers t)) + (read-string prompt nil t default)) ; t = "no history" (when (buffer-live-p minibuf) (with-current-buffer minibuf ;; Not sure why but it seems that there might be cases where the @@ -2480,7 +2491,7 @@ This finishes the change group by reverting all of its changes." ;; For compatibility. (define-obsolete-function-alias 'redraw-modeline - 'force-mode-line-update "24.2") + 'force-mode-line-update "24.3") (defun force-mode-line-update (&optional all) "Force redisplay of the current buffer's mode line and header line. @@ -2775,15 +2786,19 @@ form." (defun function-get (f prop &optional autoload) "Return the value of property PROP of function F. -If AUTOLOAD is non-nil and F is an autoloaded macro, try to autoload -the macro in the hope that it will set PROP." +If AUTOLOAD is non-nil and F is autoloaded, try to autoload it +in the hope that it will set PROP. If AUTOLOAD is `macro', only do it +if it's an autoloaded macro." (let ((val nil)) (while (and (symbolp f) (null (setq val (get f prop))) (fboundp f)) (let ((fundef (symbol-function f))) (if (and autoload (autoloadp fundef) - (not (equal fundef (autoload-do-load fundef f 'macro)))) + (not (equal fundef + (autoload-do-load fundef f + (if (eq autoload 'macro) + 'macro))))) nil ;Re-try `get' on the same `f'. (setq f fundef)))) val)) @@ -3013,6 +3028,30 @@ also `with-temp-buffer'." (set-buffer ,buffer-or-name) ,@body)) +(defun internal--before-with-selected-window (window) + (let ((other-frame (window-frame window))) + (list window (selected-window) + ;; Selecting a window on another frame also changes that + ;; frame's frame-selected-window. We must save&restore it. + (unless (eq (selected-frame) other-frame) + (frame-selected-window other-frame)) + ;; Also remember the top-frame if on ttys. + (unless (eq (selected-frame) other-frame) + (tty-top-frame other-frame))))) + +(defun internal--after-with-selected-window (state) + ;; First reset frame-selected-window. + (when (window-live-p (nth 2 state)) + ;; We don't use set-frame-selected-window because it does not + ;; pass the `norecord' argument to Fselect_window. + (select-window (nth 2 state) 'norecord) + (and (frame-live-p (nth 3 state)) + (not (eq (tty-top-frame) (nth 3 state))) + (select-frame (nth 3 state) 'norecord))) + ;; Then reset the actual selected-window. + (when (window-live-p (nth 1 state)) + (select-window (nth 1 state) 'norecord))) + (defmacro with-selected-window (window &rest body) "Execute the forms in BODY with WINDOW as the selected window. The value returned is the value of the last form in BODY. @@ -3030,34 +3069,13 @@ current buffer, since otherwise its normal operation could potentially make a different buffer current. It does not alter the buffer list ordering." (declare (indent 1) (debug t)) - ;; Most of this code is a copy of save-selected-window. - `(let* ((save-selected-window-destination ,window) - (save-selected-window-frame - (window-frame save-selected-window-destination)) - (save-selected-window-window (selected-window)) - ;; Selecting a window on another frame also changes that - ;; frame's frame-selected-window. We must save&restore it. - (save-selected-window-other-frame - (unless (eq (selected-frame) save-selected-window-frame) - (frame-selected-window save-selected-window-frame))) - (save-selected-window-top-frame - (unless (eq (selected-frame) save-selected-window-frame) - (tty-top-frame save-selected-window-frame)))) + `(let ((save-selected-window--state + (internal--before-with-selected-window ,window))) (save-current-buffer (unwind-protect - (progn (select-window save-selected-window-destination 'norecord) + (progn (select-window (car save-selected-window--state) 'norecord) ,@body) - ;; First reset frame-selected-window. - (when (window-live-p save-selected-window-other-frame) - ;; We don't use set-frame-selected-window because it does not - ;; pass the `norecord' argument to Fselect_window. - (select-window save-selected-window-other-frame 'norecord) - (and (frame-live-p save-selected-window-top-frame) - (not (eq (tty-top-frame) save-selected-window-top-frame)) - (select-frame save-selected-window-top-frame 'norecord))) - ;; Then reset the actual selected-window. - (when (window-live-p save-selected-window-window) - (select-window save-selected-window-window 'norecord)))))) + (internal--after-with-selected-window save-selected-window--state))))) (defmacro with-selected-frame (frame &rest body) "Execute the forms in BODY with FRAME as the selected frame. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 0e818e0be14..9cd69d84250 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -325,13 +325,10 @@ write-date, checksum, link-type, and link-name." (defun tar-header-data-end (descriptor) (let* ((data-start (tar-header-data-start descriptor)) (link-type (tar-header-link-type descriptor)) - (size (tar-header-size descriptor)) - (fudge (cond - ;; Foo. There's an extra empty block after these. - ((memq link-type '(20 55)) 512) - (t 0)))) - (+ data-start fudge - (if (and (null link-type) (> size 0)) + (size (tar-header-size descriptor))) + (+ data-start + ;; Ignore size for files of type 1-6 + (if (and (not (memq link-type '(1 2 3 4 5 6))) (> size 0)) (tar-roundup-512 size) 0)))) @@ -445,7 +442,8 @@ MODE should be an integer which is a file mode value." ((eq type 29) ?M) ; multivolume continuation ((eq type 35) ?S) ; sparse ((eq type 38) ?V) ; volume header - ((eq type 55) ?H) ; extended pax header + ((eq type 55) ?H) ; pax global extended header + ((eq type 72) ?X) ; pax extended header (t ?\s) ) (tar-grind-file-mode mode) @@ -751,7 +749,8 @@ tar-file's buffer." ((eq link-p 29) "a multivolume-continuation") ((eq link-p 35) "a sparse entry") ((eq link-p 38) "a volume header") - ((eq link-p 55) "an extended pax header") + ((eq link-p 55) "a pax global extended header") + ((eq link-p 72) "a pax extended header") (t "a link")))) (if (zerop size) (message "This is a zero-length file")) descriptor)) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index fb7389b856c..9b7254cd132 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1306,17 +1306,14 @@ Request data types in the order specified by `x-select-request-type'." (defun x-menu-bar-open (&optional frame) "Open the menu bar if it is shown. -`popup-menu' is used if it is off " +`popup-menu' is used if it is off." (interactive "i") (cond ((and (not (zerop (or (frame-parameter nil 'menu-bar-lines) 0))) (fboundp 'accelerate-menu)) (accelerate-menu frame)) (t - (popup-menu (mouse-menu-bar-map) - (if (listp last-nonmenu-event) - nil - 'point))))) + (popup-menu (mouse-menu-bar-map) last-nonmenu-event)))) ;;; Window system initialization. diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 76d03dd164f..a545f313650 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1790,7 +1790,7 @@ info-variant-part." ;; (defmacro artist-funcall (fn &rest args) "Call function FN with ARGS, if FN is not nil." - (list 'if fn (cons 'funcall (cons fn args)))) + `(if ,fn (funcall ,fn ,@args))) (defun artist-uniq (l) "Remove consecutive duplicates in list L. Comparison is done with `equal'." @@ -2384,8 +2384,8 @@ in the coord." ;; (defmacro artist-put-pixel (point-list x y) "In POINT-LIST, store a ``pixel'' at coord X,Y." - (list 'setq point-list - (list 'append point-list (list 'list (list 'artist-new-coord x y))))) + `(setq ,point-list + (append ,point-list (list (artist-new-coord ,x ,y))))) ;; Calculate list of points using eight point algorithm ;; return a list of coords diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 187c98af21f..3470ef9f3c1 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -90,6 +90,15 @@ (wrapfig "The wrapfigure environment" (("wrapfigure" ?f nil nil caption))) + (ctable "The ctable package" + (("\\ctable[]{}{}{}" ?t "tab:" "\\ref{%s}" 1 ("table" "Tabelle")))) + + (listings "The listings package" + (("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) + + (minted "The minted package" + (("minted" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) + ;; The LaTeX core stuff (LaTeX "LaTeX default environments" (("section" ?s "%S" "~\\ref{%s}" (nil . t) @@ -120,16 +129,7 @@ ;; The label macro is hard coded, but it *could* be defined like this: ;;("\\label{*}" nil nil nil nil) - )) - - (ctable "The ctable package" - (("\\ctable[]{}{}{}" ?t "tab:" "\\ref{%s}" 1 ("table" "Tabelle")))) - - (listings "The listings package" - (("lstlisting" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting")))) - - (minted "The minted package" - (("minted" ?l "lst:" "~\\ref{%s}" nil (regexp "[Ll]isting"))))) + ))) "The default label environment descriptions. Lower-case symbols correspond to a style file of the same name in the LaTeX distribution. Mixed-case symbols are convenience aliases.") @@ -430,7 +430,8 @@ When nil, follow-mode will be suspended for stuff in unvisited files." (defcustom reftex-default-label-alist-entries '(amsmath endnotes fancybox floatfig longtable picinpar - rotating sidecap subfigure supertab wrapfig LaTeX) + rotating sidecap subfigure supertab wrapfig + listings minted ctable LaTeX) "Default label alist specifications. LaTeX should always be the last entry. The value of this variable is a list of symbols with associations in the constant `reftex-label-alist-builtin'. Check that constant for a full list @@ -583,7 +584,7 @@ will use Any list entry may also be a symbol. If that has an association in `reftex-label-alist-builtin', the cddr of that association is spliced into the list. However, builtin defaults should normally be set with the variable -`reftex-default-label-alist-entries." +`reftex-default-label-alist-entries'." :group 'reftex-defining-label-environments :set 'reftex-set-dirty :type diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index ae2f8fb8ea2..d8afb3e5544 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1291,7 +1291,7 @@ This enforces rescanning the buffer on next use." ;; keyvals [..., label = {foo}, ...] ;; forms used by ctable, listings, ;; minted, ... - "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?[^[]*\\]" + "\\[[^]]*label[[:space:]]*=[[:space:]]*{?\\(?1:[^],}]+\\)}?" "\\)")) (include-re (concat wbol "\\\\\\(" diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 77dc7cc29bb..767f8f360bb 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -215,12 +215,12 @@ Starts with the current official version. For developer versions in parentheses follows the development revision and the time stamp.") (defconst rst-package-emacs-version-alist - '(("1.0.0" . "24.2") - ("1.1.0" . "24.2") - ("1.2.0" . "24.2") - ("1.2.1" . "24.2") - ("1.3.0" . "24.2") - ("1.3.1" . "24.2") + '(("1.0.0" . "24.3") + ("1.1.0" . "24.3") + ("1.2.0" . "24.3") + ("1.2.1" . "24.3") + ("1.3.0" . "24.3") + ("1.3.1" . "24.3") )) (unless (assoc rst-official-version rst-package-emacs-version-alist) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 5571af1ad9b..620a1da633e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1286,7 +1286,8 @@ inserts \" characters." (delete-char (length tex-open-quote)) t))) (self-insert-command (prefix-numeric-value arg)) - (insert (if (memq (char-syntax (preceding-char)) '(?\( ?> ?\s)) + (insert (if (or (memq (char-syntax (preceding-char)) '(?\( ?> ?\s)) + (memq (preceding-char) '(?~))) tex-open-quote tex-close-quote)))) (defun tex-validate-buffer () @@ -1498,7 +1499,7 @@ Puts point on a blank line between them." (defvar latex-complete-bibtex-cache nil) (define-obsolete-function-alias 'latex-string-prefix-p - 'string-prefix-p "24.2") + 'string-prefix-p "24.3") (defvar bibtex-reference-key) (declare-function reftex-get-bibfile-list "reftex-cite.el" ()) @@ -1722,9 +1723,12 @@ Mark is left at original location." "Like `forward-sexp' but aware of multi-char elements and escaped parens." (interactive "P") (unless arg (setq arg 1)) - (let ((pos (point))) + (let ((pos (point)) + (opoint 0)) (condition-case err - (while (/= arg 0) + (while (and (/= (point) opoint) + (/= arg 0)) + (setq opoint (point)) (setq arg (if (> arg 0) (progn (latex-forward-sexp-1) (1- arg)) @@ -2055,7 +2059,7 @@ IN can be either a string (with the same % escapes in it) indicating OUT describes the output file and is either a %-escaped string or nil to indicate that there is no output file.") -(define-obsolete-function-alias 'tex-string-prefix-p 'string-prefix-p "24.2") +(define-obsolete-function-alias 'tex-string-prefix-p 'string-prefix-p "24.3") (defun tex-guess-main-file (&optional all) "Find a likely `tex-main-file'. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 9d0fbaae9d8..a57054acdd6 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -25,6 +25,8 @@ ;;; Code: +(require 'syntax) + (defvar comint-prompt-regexp) (defgroup tooltip nil @@ -277,8 +279,11 @@ Value is nil if no identifier exists at point. Identifier extraction is based on the current syntax table." (save-excursion (goto-char point) - (let ((start (progn (skip-syntax-backward "w_") (point)))) - (unless (looking-at "[0-9]") + (let* ((start (progn (skip-syntax-backward "w_") (point))) + (pstate (syntax-ppss))) + (unless (or (looking-at "[0-9]") + (nth 3 pstate) + (nth 4 pstate)) (skip-syntax-forward "w_") (when (> (point) start) (buffer-substring start (point))))))) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index e0e2a82fab9..64879e5cfd5 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -829,7 +829,8 @@ Run the Viper tutorial? ")) (if old-tut-file (progn (insert-file-contents (tutorial--saved-file)) - (let ((enable-local-variables :safe)) + (let ((enable-local-variables :safe) + (enable-local-eval nil)) (hack-local-variables)) ;; FIXME? What we actually want is to ignore dir-locals (?). (setq buffer-read-only nil) ; bug#11118 @@ -848,7 +849,8 @@ Run the Viper tutorial? ")) (goto-char tutorial--point-before-chkeys) (setq tutorial--point-before-chkeys (point-marker))) (insert-file-contents (expand-file-name filename tutorial-directory)) - (let ((enable-local-variables :safe)) + (let ((enable-local-variables :safe) + (enable-local-eval nil)) (hack-local-variables)) ;; FIXME? What we actually want is to ignore dir-locals (?). (setq buffer-read-only nil) ; bug#11118 diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index ae224f4102f..a72f12ccb9b 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,6 +1,21 @@ +2012-08-14 Stefan Monnier + + * url-http.el (url-http-parse-headers): Re-enable file-name-handlers + (bug#11981). + +2012-08-12 David Engster + + * url-util.el (url-file-directory, url-file-nondirectory): Avoid + file-name-directory and file-name-nondirectory internally (bug#11981). + +2012-08-11 Jason Rumney + + * url-http.el (url-http-create-request): Use url-http-proxy to + look up proxy credentials (Bug#12069). + 2012-07-28 David Engster - * url-dav.el (url-dav-supported-p): Added doc-string and remove + * url-dav.el (url-dav-supported-p): Add doc-string and remove check for feature `xml' and function `xml-expand-namespace' which never existed in Emacs proper. (url-dav-process-response): Remove all indentation and newlines @@ -58,8 +73,8 @@ 2012-05-10 Chong Yidong - * url-parse.el (url-path-and-query, url-port-if-non-default): New - functions. + * url-parse.el (url-path-and-query, url-port-if-non-default): + New functions. (url-generic-parse-url): Don't set the portspec slot if it is not specified; that is what `url-port' is for. (url-port): Only require the scheme to be specified to call diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 0b5ecc7bf98..18d28e89f78 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -239,7 +239,7 @@ request.") nil (let ((url-basic-auth-storage 'url-http-proxy-basic-auth-storage)) - (url-get-authentication url-http-target-url nil 'any nil)))) + (url-get-authentication url-http-proxy nil 'any nil)))) (real-fname (url-filename url-http-target-url)) (host (url-host url-http-target-url)) (auth (if (cdr-safe (assoc "Authorization" url-http-extra-headers)) @@ -508,13 +508,10 @@ should be shown to the user." (class nil) (success nil) ;; other status symbols: jewelry and luxury cars - (status-symbol (cadr (assq url-http-response-status url-http-codes))) - ;; The filename part of a URL could be in remote file syntax, - ;; see Bug#6717 for an example. We disable file name - ;; handlers, therefore. - (file-name-handler-alist nil)) + (status-symbol (cadr (assq url-http-response-status url-http-codes)))) (setq class (/ url-http-response-status 100)) - (url-http-debug "Parsed HTTP headers: class=%d status=%d" class url-http-response-status) + (url-http-debug "Parsed HTTP headers: class=%d status=%d" + class url-http-response-status) (when (url-use-cookies url-http-target-url) (url-http-handle-cookies)) @@ -531,7 +528,8 @@ should be shown to the user." ;; 101 = Switching protocols ;; 102 = Processing (Added by DAV) (url-mark-buffer-as-dead buffer) - (error "HTTP responses in class 1xx not supported (%d)" url-http-response-status)) + (error "HTTP responses in class 1xx not supported (%d)" + url-http-response-status)) (2 ; Success ;; 200 Ok ;; 201 Created diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 46ad1daef01..4007d1f35b3 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -105,7 +105,7 @@ If the specified port number is the default, return nil." (concat (car x) "=" (cdr x)) (car x))) (url-attributes urlobj) ";")))) -(make-obsolete 'url-recreate-url-attributes nil "24.2") +(make-obsolete 'url-recreate-url-attributes nil "24.3") ;;;###autoload (defun url-generic-parse-url (url) diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 2faca26f2dd..f654830e387 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -247,8 +247,9 @@ Will not do anything if `url-show-status' is nil." (cond ((null file) "") ((string-match "\\?" file) - (file-name-directory (substring file 0 (match-beginning 0)))) - (t (file-name-directory file)))) + (url-file-directory (substring file 0 (match-beginning 0)))) + ((string-match "\\(.*\\(/\\|%2[fF]\\)\\)" file) + (match-string 1 file)))) ;;;###autoload (defun url-file-nondirectory (file) @@ -256,8 +257,10 @@ Will not do anything if `url-show-status' is nil." (cond ((null file) "") ((string-match "\\?" file) - (file-name-nondirectory (substring file 0 (match-beginning 0)))) - (t (file-name-nondirectory file)))) + (url-file-nondirectory (substring file 0 (match-beginning 0)))) + ((string-match ".*\\(?:/\\|%2[fF]\\)\\(.*\\)" file) + (match-string 1 file)) + (t file))) ;;;###autoload (defun url-parse-query-string (query &optional downcase allow-newlines) diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 9401ae07093..fb6f8d4d58b 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -229,7 +229,7 @@ Note: The search is conducted only within 10%, at the beginning of the file." :version "21.1" :group 'change-log) (define-obsolete-face-alias 'change-log-acknowledgement - 'change-log-acknowledgment "24.2") + 'change-log-acknowledgment "24.3") (define-obsolete-face-alias 'change-log-acknowledgement-face 'change-log-acknowledgment "22.1") @@ -1049,6 +1049,7 @@ Runs `change-log-mode-hook'. show-trailing-whitespace t) (set (make-local-variable 'fill-forward-paragraph-function) 'change-log-fill-forward-paragraph) + (set (make-local-variable 'comment-start) nil) ;; Make sure we call `change-log-indent' when filling. (set (make-local-variable 'fill-indent-according-to-mode) t) ;; Avoid that filling leaves behind a single "*" on a line. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a9d124700b8..c6a9371ea9a 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1902,7 +1902,7 @@ For use in `add-log-current-defun-function'." :background "#aa2222")) "Face used for removed characters shown by `diff-refine-hunk'." :group 'diff-mode - :version "24.2") + :version "24.3") (defface diff-refine-added '((default @@ -1913,7 +1913,7 @@ For use in `add-log-current-defun-function'." :background "#22aa22")) "Face used for added characters shown by `diff-refine-hunk'." :group 'diff-mode - :version "24.2") + :version "24.3") (defun diff-refine-preproc () (while (re-search-forward "^[+>]" nil t) @@ -2016,6 +2016,36 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks." ;; When there's no more hunks, diff-hunk-next signals an error. (error nil)))) +(defun diff-remove-trailing-whitespace () + "When on a buffer that contains a diff, inspects the +differences and removes trailing whitespace (spaces, tabs) from +the lines modified or introduced by this diff. Shows a message +with the name of the altered buffers, which are unsaved. If a +file referenced on the diff has no buffer and needs to be fixed, +a buffer visiting that file is created." + (interactive) + ;; We assume that the diff header has no trailing whitespace. + (let ((modified-buffers nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[+!>].*[ \t]+$" (point-max) t) + (pcase-let ((`(,buf ,line-offset ,pos ,src ,_dst ,_switched) + (diff-find-source-location t t))) + (when line-offset + (with-current-buffer buf + (save-excursion + (goto-char (+ (car pos) (cdr src))) + (beginning-of-line) + (when (re-search-forward "\\([ \t]+\\)$" (line-end-position) t) + (unless (memq buf modified-buffers) + (push buf modified-buffers)) + (replace-match "")))))))) + (if modified-buffers + (message "Deleted new trailing whitespace from: %s" + (mapconcat (lambda (buf) (concat "`" (buffer-name buf) "'")) + modified-buffers " ")) + (message "No trailing whitespace fixes needed.")))) + ;; provide the package (provide 'diff-mode) diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index cc8ef4ad5c0..eee3f40fd96 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -68,7 +68,7 @@ 'ediff-setup-windows-plain)) (make-obsolete 'ediff-choose-window-setup-function-automatically - 'ediff-setup-windows-default "24.2") + 'ediff-setup-windows-default "24.3") (defcustom ediff-window-setup-function 'ediff-setup-windows-default "Function called to set up windows. @@ -102,7 +102,7 @@ provided functions are written." (const :tag "Single Frame" ediff-setup-windows-plain) (function :tag "Other function")) :group 'ediff-window - :version "24.2") + :version "24.3") ;; indicates if we are in a multiframe setup (ediff-defvar-local ediff-multiframe nil "") diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 6514fbd22d7..9dda78d0314 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -452,7 +452,7 @@ It assumes that a log entry starts with a line matching (defun log-view-minor-wrap (buf f) (let ((data (with-current-buffer buf (let* ((beg (point)) - (end (if mark-active (mark) (point))) + (end (if (use-region-p) (mark) (point))) (fr (log-view-current-tag beg)) (to (log-view-current-tag end))) (when (string-equal fr to) @@ -537,15 +537,17 @@ It assumes that a log entry starts with a line matching (defun log-view-diff (beg end) "Get the diff between two revisions. -If the mark is not active or the mark is on the revision at point, -get the diff between the revision at point and its previous revision. -Otherwise, get the diff between the revisions where the region starts -and ends. -Contrary to `log-view-diff-changeset', it will only show the part of the -changeset that affected the currently considered file(s)." +If the region is inactive or the mark is on the revision at +point, get the diff between the revision at point and its +previous revision. Otherwise, get the diff between the revisions +where the region starts and ends. + +Unlike `log-view-diff-changeset', this function only shows the +part of the changeset which affected the currently considered +file(s)." (interactive - (list (if mark-active (region-beginning) (point)) - (if mark-active (region-end) (point)))) + (list (if (use-region-p) (region-beginning) (point)) + (if (use-region-p) (region-end) (point)))) (let ((fr (log-view-current-tag beg)) (to (log-view-current-tag end))) (when (string-equal fr to) @@ -562,15 +564,17 @@ changeset that affected the currently considered file(s)." (defun log-view-diff-changeset (beg end) "Get the diff between two revisions. -If the mark is not active or the mark is on the revision at point, -get the diff between the revision at point and its previous revision. -Otherwise, get the diff between the revisions where the region starts -and ends. -Contrary to `log-view-diff', it will show the whole changeset including -the changes that affected other files than the currently considered file(s)." +If the region is inactive or the mark is on the revision at +point, get the diff between the revision at point and its +previous revision. Otherwise, get the diff between the revisions +where the region starts and ends. + +Unlike `log-view-diff' this function shows the whole changeset, +including changes affecting other files than the currently +considered file(s)." (interactive - (list (if mark-active (region-beginning) (point)) - (if mark-active (region-end) (point)))) + (list (if (use-region-p) (region-beginning) (point)) + (if (use-region-p) (region-end) (point)))) (when (eq (vc-call-backend log-view-vc-backend 'revision-granularity) 'file) (error "The %s backend does not support changeset diffs" log-view-vc-backend)) (let ((fr (log-view-current-tag beg)) diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 3d54bbd12a3..fdef490d4a2 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -182,7 +182,7 @@ arguments. If ARGS is not a list, no argument will be passed." (if oneline (line-end-position) (point-max)))) (file-error nil))) -(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.2") +(define-obsolete-function-alias 'cvs-string-prefix-p 'string-prefix-p "24.3") ;;;; ;;;; file names diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index e6b63030fef..babcf6f1beb 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -138,7 +138,7 @@ Used in `smerge-diff-base-mine' and related functions." (t :inverse-video t)) "Face used for removed characters shown by `smerge-refine'." :group 'smerge - :version "24.2") + :version "24.3") (defface smerge-refined-added '((default @@ -150,7 +150,7 @@ Used in `smerge-diff-base-mine' and related functions." (t :inverse-video t)) "Face used for added characters shown by `smerge-refine'." :group 'smerge - :version "24.2") + :version "24.3") (easy-mmode-defmap smerge-basic-map `(("n" . smerge-next) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 7c840fd071b..455f48c50d3 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1106,9 +1106,22 @@ outside of VC) and one wants to do some operation on it." (interactive "fShow file: ") (vc-dir-update (list (list (file-relative-name file) (vc-state file))) (current-buffer))) -(defun vc-dir-hide-up-to-date () - "Hide up-to-date items from display." - (interactive) +(defun vc-dir-hide-state (&optional state) + "Hide items that are in STATE from display. +See `vc-state' for valid values of STATE. + +If STATE is nil, default it to up-to-date. + +Interactively, if `current-prefix-arg' is non-nil, set STATE to +state of item at point. Otherwise, set STATE to up-to-date." + (interactive (list + (and current-prefix-arg + ;; Command is prefixed. Infer STATE from point. + (let ((node (ewoc-locate vc-ewoc))) + (and node (vc-dir-fileinfo->state (ewoc-data node))))))) + ;; If STATE is un-specified, use up-to-date. + (setq state (or state 'up-to-date)) + (message "Hiding items in state \"%s\"" state) (let ((crt (ewoc-nth vc-ewoc -1)) (first (ewoc-nth vc-ewoc 0))) ;; Go over from the last item to the first and remove the @@ -1120,18 +1133,21 @@ outside of VC) and one wants to do some operation on it." (prev (ewoc-prev vc-ewoc crt)) ;; ewoc-delete does not work without this... (inhibit-read-only t)) - (when (or - ;; Remove directories with no child files. - (and dir - (or - ;; Nothing follows this directory. - (not next) - ;; Next item is a directory. - (vc-dir-fileinfo->directory (ewoc-data next)))) - ;; Remove files in the up-to-date state. - (eq (vc-dir-fileinfo->state data) 'up-to-date)) - (ewoc-delete vc-ewoc crt)) - (setq crt prev))))) + (when (or + ;; Remove directories with no child files. + (and dir + (or + ;; Nothing follows this directory. + (not next) + ;; Next item is a directory. + (vc-dir-fileinfo->directory (ewoc-data next)))) + ;; Remove files in specified STATE. STATE can be a + ;; symbol or a user-name. + (equal (vc-dir-fileinfo->state data) state)) + (ewoc-delete vc-ewoc crt)) + (setq crt prev))))) + +(defalias 'vc-dir-hide-up-to-date 'vc-dir-hide-state) (defun vc-dir-kill-line () "Remove the current line from display." diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 67c0f985ae1..8429b2b213d 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -305,29 +305,28 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ids))) (defun vc-mtn-revision-completion-table (_files) - ;; TODO: Implement completion for selectors - ;; TODO: Implement completion for composite selectors. ;; What about using `files'?!? --Stef (lambda (string pred action) (cond + ;; Special chars for composite selectors. + ((string-match ".*[^\\]\\(\\\\\\\\\\)*[/|;(]" string) + (completion-table-with-context (substring string 0 (match-end 0)) + (vc-mtn-revision-completion-table nil) + (substring string (match-end 0)) + pred action)) ;; "Tag" selectors. ((string-match "\\`t:" string) (complete-with-action action (mapcar (lambda (tag) (concat "t:" tag)) (vc-mtn-list-tags)) string pred)) - ;; "Branch" selectors. - ((string-match "\\`b:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "b:" tag)) - (vc-mtn-list-branches)) - string pred)) - ;; "Head" selectors. Not sure how they differ from "branch" selectors. - ((string-match "\\`h:" string) - (complete-with-action action - (mapcar (lambda (tag) (concat "h:" tag)) - (vc-mtn-list-branches)) - string pred)) + ;; "Branch" or "Head" selectors. + ((string-match "\\`[hb]:" string) + (let ((prefix (match-string 0 string))) + (complete-with-action action + (mapcar (lambda (tag) (concat prefix tag)) + (vc-mtn-list-branches)) + string pred))) ;; "ID" selectors. ((string-match "\\`i:" string) (complete-with-action action @@ -339,7 +338,13 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (complete-with-action action '("t:" "b:" "h:" "i:" ;; Completion not implemented for these. - "a:" "c:" "d:" "e:" "l:") + "c:" "a:" "k:" "d:" "m:" "e:" "l:" "i:" "p:" + ;; These have no arg to complete. + "u:" "w:" + ;; Selector functions. + "difference(" "lca(" "max(" "ancestors(" + "descendants(" "parents(" "children(" + "pick(") string pred))))) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 2d95b14244f..ddb9565544d 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1652,8 +1652,9 @@ Return t if the buffer had changes, nil otherwise." (setq rev1-default (vc-working-revision first))) ;; if the file is not locked, use last and previous revisions as defaults (t - (setq rev1-default (vc-call-backend backend 'previous-revision first - (vc-working-revision first))) + (setq rev1-default (ignore-errors ;If `previous-revision' doesn't work. + (vc-call-backend backend 'previous-revision first + (vc-working-revision first)))) (when (string= rev1-default "") (setq rev1-default nil)) (setq rev2-default (vc-working-revision first)))) ;; construct argument list @@ -2803,7 +2804,7 @@ to provide the `find-revision' operation instead." ;; These things should probably be generally available -(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.2") +(define-obsolete-function-alias 'vc-string-prefix-p 'string-prefix-p "24.3") (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. diff --git a/lisp/wdired.el b/lisp/wdired.el index d5ce0beccbb..b893e8f6f2b 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -183,14 +183,21 @@ program `dired-chmod-program', which must exist." (defun wdired-mode () - "Writable Dired mode. + "Writable Dired (WDired) mode. \\ -Press \\[wdired-finish-edit] to make the changes to take effect -and exit. To abort the edit, use \\[wdired-abort-changes]. +In WDired mode, you can edit the names of the files in the +buffer, the target of the links, and the permission bits of the +files. -In this mode you can edit the names of the files, the target of -the links and the permission bits of the files. You can use -\\[customize-group] RET wdired to customize WDired behavior. +Type \\[wdired-finish-edit] to exit WDired mode, returning to +Dired mode, and make your edits \"take effect\" by modifying the +file and directory names, link targets, and/or file permissions +on disk. If you delete the filename of a file, it is flagged for +deletion in the Dired buffer. + +Type \\[wdired-abort-changes] to abort your edits and exit WDired mode. + +Type \\[customize-group] RET wdired to customize WDired behavior. The only editable texts in a WDired buffer are filenames, symbolic link targets, and filenames permission." @@ -201,16 +208,17 @@ symbolic link targets, and filenames permission." ;;;###autoload (defun wdired-change-to-wdired-mode () - "Put a dired buffer in a mode in which filenames are editable. + "Put a Dired buffer in Writable Dired (WDired) mode. \\ -This mode allows the user to change the names of the files, and after -typing \\[wdired-finish-edit] Emacs renames the files and directories -in disk. +In WDired mode, you can edit the names of the files in the +buffer, the target of the links, and the permission bits of the +files. After typing \\[wdired-finish-edit], Emacs modifies the files and +directories to reflect your edits. See `wdired-mode'." (interactive) - (or (eq major-mode 'dired-mode) - (error "Not a Dired buffer")) + (unless (eq major-mode 'dired-mode) + (error "Not a Dired buffer")) (set (make-local-variable 'wdired-old-content) (buffer-substring (point-min) (point-max))) (set (make-local-variable 'wdired-old-point) (point)) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 9c317e32816..f52a8fb36ae 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -927,17 +927,13 @@ Used when `whitespace-style' includes `lines' or `lines-tail'." '( (space-mark ?\ [?\u00B7] [?.]) ; space - centered dot (space-mark ?\xA0 [?\u00A4] [?_]) ; hard space - currency - (space-mark ?\x8A0 [?\x8A4] [?_]) ; hard space - currency - (space-mark ?\x920 [?\x924] [?_]) ; hard space - currency - (space-mark ?\xE20 [?\xE24] [?_]) ; hard space - currency - (space-mark ?\xF20 [?\xF24] [?_]) ; hard space - currency ;; NEWLINE is displayed using the face `whitespace-newline' (newline-mark ?\n [?$ ?\n]) ; eol - dollar sign ;; (newline-mark ?\n [?\u21B5 ?\n] [?$ ?\n]) ; eol - downwards arrow ;; (newline-mark ?\n [?\u00B6 ?\n] [?$ ?\n]) ; eol - pilcrow - ;; (newline-mark ?\n [?\x8AF ?\n] [?$ ?\n]) ; eol - overscore - ;; (newline-mark ?\n [?\x8AC ?\n] [?$ ?\n]) ; eol - negation - ;; (newline-mark ?\n [?\x8B0 ?\n] [?$ ?\n]) ; eol - grade + ;; (newline-mark ?\n [?\u00AF ?\n] [?$ ?\n]) ; eol - overscore + ;; (newline-mark ?\n [?\u00AC ?\n] [?$ ?\n]) ; eol - negation + ;; (newline-mark ?\n [?\u00B0 ?\n] [?$ ?\n]) ; eol - degrees ;; ;; WARNING: the mapping below has a problem. ;; When a TAB occupies exactly one column, it will display the diff --git a/lisp/window.el b/lisp/window.el index 910164043d9..5682e7e909a 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4238,7 +4238,7 @@ These supersede the values given in `default-frame-alist'." :group 'frames) (defun special-display-popup-frame (buffer &optional args) - "Display BUFFER and return the window chosen. + "Pop up a frame displaying BUFFER and return its window. If BUFFER is already displayed in a visible or iconified frame, raise that frame. Otherwise, display BUFFER in a new frame. @@ -4602,27 +4602,26 @@ is passed unaltered to `display-buffer-record-window'. Set `window-dedicated-p' to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are live." (when (and (buffer-live-p buffer) (window-live-p window)) - (let* ((frame (window-frame window)) - (visible (frame-visible-p frame))) - (unless (eq buffer (window-buffer window)) - (set-window-dedicated-p window nil) - (display-buffer-record-window type window buffer) - (set-window-buffer window buffer) - (when dedicated - (set-window-dedicated-p window dedicated)) - (when (memq type '(window frame)) - (set-window-prev-buffers window nil))) + (unless (eq buffer (window-buffer window)) + (set-window-dedicated-p window nil) + (display-buffer-record-window type window buffer) + (set-window-buffer window buffer) + (when dedicated + (set-window-dedicated-p window dedicated)) + (when (memq type '(window frame)) + (set-window-prev-buffers window nil))) + window)) - (unless (or (not visible) - ;; Assume the selected frame is already visible enough. - (eq frame (selected-frame)) - ;; Assume the frame from which we invoked the minibuffer - ;; is visible. - (and (minibuffer-window-active-p (selected-window)) - (eq frame (window-frame (minibuffer-selected-window))))) - (raise-frame frame)) - - window))) +(defun window--maybe-raise-frame (frame) + (let ((visible (frame-visible-p frame))) + (unless (or (not visible) + ;; Assume the selected frame is already visible enough. + (eq frame (selected-frame)) + ;; Assume the frame from which we invoked the + ;; minibuffer is visible. + (and (minibuffer-window-active-p (selected-window)) + (eq frame (window-frame (minibuffer-selected-window))))) + (raise-frame frame)))) ;; FIXME: Not implemented. ;; FIXME: By the way, there could be more levels of dedication: @@ -4771,6 +4770,10 @@ Recognized alist entries include: `inhibit-same-window' -- A non-nil value prevents the same window from being used for display. + `inhibit-switch-frame' -- A non-nil value prevents any other + frame from being raised or selected, + even if the window is displayed there. + `reusable-frames' -- Value specifies frame(s) to search for a window that already displays the buffer. See `display-buffer-reuse-window'. @@ -4872,7 +4875,11 @@ which frames to search for a reusable window: If ALIST contains no `reusable-frames' entry, search just the selected frame if `display-buffer-reuse-frames' and `pop-up-frames' are both nil; search all frames on the current -terminal if either of those variables is non-nil." +terminal if either of those variables is non-nil. + +If ALIST has a non-nil `inhibit-switch-frame' entry, then in the +event that a window on another frame is chosen, avoid raising +that frame." (let* ((alist-entry (assq 'reusable-frames alist)) (frames (cond (alist-entry (cdr alist-entry)) ((if (eq pop-up-frames 'graphic-only) @@ -4887,8 +4894,10 @@ terminal if either of those variables is non-nil." (car (delq (selected-window) (get-buffer-window-list buffer 'nomini frames)))))) - (when window - (window--display-buffer buffer window 'reuse)))) + (when (window-live-p window) + (prog1 (window--display-buffer buffer window 'reuse) + (unless (cdr (assq 'inhibit-switch-frame alist)) + (window--maybe-raise-frame (window-frame window))))))) (defun display-buffer--special-action (buffer) "Return special display action for BUFFER, if any. @@ -4905,23 +4914,32 @@ See `display-buffer' for the format of display actions." (funcall special-display-function buffer ',(if (listp pars) pars))))))))) -(defun display-buffer-pop-up-frame (buffer _alist) +(defun display-buffer-pop-up-frame (buffer alist) "Display BUFFER in a new frame. This works by calling `pop-up-frame-function'. If successful, -return the window used; otherwise return nil." +return the window used; otherwise return nil. + +If ALIST has a non-nil `inhibit-switch-frame' entry, avoid +raising the new frame." (let ((fun pop-up-frame-function) frame window) (when (and fun (setq frame (funcall fun)) (setq window (frame-selected-window frame))) - (window--display-buffer - buffer window 'frame display-buffer-mark-dedicated)))) + (prog1 (window--display-buffer buffer window + 'frame display-buffer-mark-dedicated) + (unless (cdr (assq 'inhibit-switch-frame alist)) + (window--maybe-raise-frame frame)))))) -(defun display-buffer-pop-up-window (buffer _alist) +(defun display-buffer-pop-up-window (buffer alist) "Display BUFFER by popping up a new window. The new window is created on the selected frame, or in `last-nonminibuffer-frame' if no windows can be created there. -If successful, return the new window; otherwise return nil." +If successful, return the new window; otherwise return nil. + +If ALIST has a non-nil `inhibit-switch-frame' entry, then in the +event that the new window is created on another frame, avoid +raising the frame." (let ((frame (or (window--frame-usable-p (selected-frame)) (window--frame-usable-p (last-nonminibuffer-frame)))) window) @@ -4937,8 +4955,10 @@ If successful, return the new window; otherwise return nil." (get-largest-window frame t)) (window--try-to-split-window (get-lru-window frame t))))) - (window--display-buffer - buffer window 'window display-buffer-mark-dedicated)))) + (prog1 (window--display-buffer buffer window + 'window display-buffer-mark-dedicated) + (unless (cdr (assq 'inhibit-switch-frame alist)) + (window--maybe-raise-frame (window-frame window))))))) (defun display-buffer--maybe-pop-up-frame-or-window (buffer alist) "Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'. @@ -4958,7 +4978,11 @@ again with `display-buffer-pop-up-window'." (defun display-buffer-use-some-window (buffer alist) "Display BUFFER in an existing window. Search for a usable window, set that window to the buffer, and -return the window. If no suitable window is found, return nil." +return the window. If no suitable window is found, return nil. + +If ALIST has a non-nil `inhibit-switch-frame' entry, then in the +event that a window in another frame is chosen, avoid raising +that frame." (let* ((not-this-window (cdr (assq 'inhibit-same-window alist))) (frame (or (window--frame-usable-p (selected-frame)) (window--frame-usable-p (last-nonminibuffer-frame)))) @@ -4975,9 +4999,11 @@ return the window. If no suitable window is found, return nil." (eq window (selected-window))) window)) (get-largest-window 0 not-this-window)))) - (when window + (when (window-live-p window) (window--even-window-heights window) - (window--display-buffer buffer window 'reuse)))) + (prog1 (window--display-buffer buffer window 'reuse) + (unless (cdr (assq 'inhibit-switch-frame alist)) + (window--maybe-raise-frame (window-frame window))))))) ;;; Display + selection commands: (defun pop-to-buffer (buffer &optional action norecord) diff --git a/lisp/woman.el b/lisp/woman.el index 4a1e9a83efa..5933d593aa5 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -2531,7 +2531,8 @@ REQUEST is the invoking directive without the leading dot." (cond ;; ((looking-at "[no]") (setq c t)) ; accept n(roff) and o(dd page) ;; ((looking-at "[te]") (setq c nil)) ; reject t(roff) and e(ven page) - ((looking-at "[ntoe]") + ;; Per groff ".if v" is recognised as false (it means -Tversatec). + ((looking-at "[ntoev]") (setq c (memq (following-char) woman-if-conditions-true))) ;; Unrecognized letter so reject: ((looking-at "[A-Za-z]") (setq c nil) @@ -3569,7 +3570,7 @@ expression in parentheses. Leaves point after the value." (let (n) (forward-char) (setq n (woman-parse-numeric-arg)) - (skip-syntax-forward " ") + (skip-syntax-forward " " (line-end-position)) (if (eq (following-char) ?\)) (forward-char) (WoMan-warn "Parenthesis confusion in numeric expression!")) @@ -3621,7 +3622,7 @@ expression in parentheses. Leaves point after the value." (buffer-substring (point) (line-end-position))) - (skip-syntax-forward "^ ") + (skip-syntax-forward "^ " (line-end-position)) 0) (goto-char (match-end 0)) ;; Check for scale factor: diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 207a1200169..8d36e2e22d7 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,7 @@ +2012-08-01 Glenn Morris + + * Makefile.in (config_h): Add conf_post.h. + 2012-07-31 Dmitry Antipov Avoid unused variable warning if --with-x-toolkit=motif. diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index d49f69b58a4..2e70e0a4b6d 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -69,7 +69,7 @@ liblw.a: $(OBJS) $(RANLIB) $@ ## Generated files in ../src, non-generated in $(srcdir)/../src. -config_h = ../src/config.h +config_h = ../src/config.h $(srcdir)/../src/conf_post.h lisp_h = $(srcdir)/../src/lisp.h ## lisp.h includes this. globals_h = ../src/globals.h diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 new file mode 100644 index 00000000000..187a33599a3 --- /dev/null +++ b/m4/extern-inline.m4 @@ -0,0 +1,41 @@ +dnl 'extern inline' a la ISO C99. + +dnl Copyright 2012 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_EXTERN_INLINE], +[ + AC_REQUIRE([AC_C_INLINE]) + AH_VERBATIM([extern_inline], +[/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'. + _GL_EXTERN_INLINE is a portable alternative to 'extern inline'. + _GL_INLINE_HEADER_BEGIN contains useful stuff to put + in an include file, before uses of _GL_INLINE. + It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic, + when FOO is an inline function in the header; see + . + _GL_INLINE_HEADER_END contains useful stuff to put + in the same include file, after uses of _GL_INLINE. */ +#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +# define _GL_INLINE inline +# define _GL_EXTERN_INLINE extern inline +# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# define _GL_INLINE_HEADER_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") +# define _GL_INLINE_HEADER_END \ + _Pragma ("GCC diagnostic pop") +# endif +#else +# define _GL_INLINE static inline +# define _GL_EXTERN_INLINE static inline +#endif + +#ifndef _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_END +#endif]) +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index b0cd185a2b5..c4deb8d42fb 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -55,6 +55,7 @@ AC_DEFUN([gl_EARLY], # Code from module environ: # Code from module extensions: AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + # Code from module extern-inline: # Code from module filemode: # Code from module getloadavg: # Code from module getopt-gnu: @@ -151,6 +152,7 @@ fi gl_UNISTD_MODULE_INDICATOR([dup2]) gl_ENVIRON gl_UNISTD_MODULE_INDICATOR([environ]) +AC_REQUIRE([gl_EXTERN_INLINE]) gl_FILEMODE gl_GETLOADAVG if test $HAVE_GETLOADAVG = 0; then @@ -261,7 +263,6 @@ if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then fi gl_TIME_MODULE_INDICATOR([time_r]) gl_TIMESPEC -AC_REQUIRE([AC_C_INLINE]) gl_UNISTD_H gl_UTIMENS gl_gnulib_enabled_dosname=false @@ -565,6 +566,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/sha512.c lib/sha512.h lib/signal.in.h + lib/stat-time.c lib/stat-time.h lib/stat.c lib/stdalign.in.h @@ -590,7 +592,9 @@ AC_DEFUN([gl_FILE_LIST], [ lib/time_r.c lib/timespec-add.c lib/timespec-sub.c + lib/timespec.c lib/timespec.h + lib/u64.c lib/u64.h lib/unistd.in.h lib/utimens.c @@ -603,6 +607,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/dup2.m4 m4/environ.m4 m4/extensions.m4 + m4/extern-inline.m4 m4/filemode.m4 m4/getloadavg.m4 m4/getopt.m4 diff --git a/make-dist b/make-dist index cc14ff3987b..b157d9a54d6 100755 --- a/make-dist +++ b/make-dist @@ -282,7 +282,7 @@ for subdir in site-lisp \ leim leim/CXTERM-DIC leim/MISC-DIC \ leim/SKK-DIC leim/ja-dic leim/quail \ build-aux build-aux/snippet \ - src src/s src/bitmaps lib lib-src oldXMenu lwlib \ + src src/bitmaps lib lib-src oldXMenu lwlib \ nt nt/inc nt/inc/sys nt/inc/arpa nt/inc/netinet nt/icons \ `find etc lisp admin -type d` \ doc doc/emacs doc/misc doc/man doc/lispref doc/lispintro \ @@ -359,10 +359,6 @@ echo "Making links to \`src/bitmaps'" (cd src/bitmaps ln README *.xbm ../../${tempdir}/src/bitmaps) -echo "Making links to \`src/s'" -(cd src/s - ln README [a-zA-Z0-9]*.h ../../${tempdir}/src/s) - echo "Making links to \`lib'" (snippet_h=`(cd build-aux/snippet && ls *.h)` cd lib diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 503c7cbf8a1..45666a335de 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,25 @@ +2012-08-04 Eli Zaretskii + + * sedlibmk.inp (allocator.$(OBJEXT), careadlinkat.$(OBJEXT)): Fix + editing out. + + * sed2v2.inp (IS_DEVICE_SEP): Edit to match ':'. + (IS_DIRECTORY_SEP, INTERNAL_TERMINAL): Fix Sed command syntax. + (MSDOS): Define only if undefined, as MSDOS is a built-in macro, + unless some std= switch to GCC is used. + +2012-08-01 Glenn Morris + + * sed2v2.inp (HAVE_WCHAR_H): Fix typo. + + * sed2v2.inp (MSDOS, DOS_NT, FLOAT_CHECK_DOMAIN) + (HAVE_INVERSE_HYPERBOLIC, DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP) + (INTERNAL_TERMINAL, NULL_DEVICE, SEPCHAR, USER_FULL_NAME) + (_setjmp, _longjmp): Move here from src/s/msdos.h. + (config_opsysfile, config_machfile): Remove. + * sed1v2.inp (M_FILE, S_FILE): Remove. + * mainmake.v2 (TAGS, tags): Remove src/s/msdos.h. + 2012-07-31 Glenn Morris * sed1v2.inp (S_FILE): Update for format change. diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2 index e1e646a855c..3df6ca17827 100644 --- a/msdos/mainmake.v2 +++ b/msdos/mainmake.v2 @@ -161,8 +161,7 @@ TAGS tags: lib-src FRC cd src ../bin/etags --include=../lisp/TAGS \ --regex='/[ ]*DEFVAR_[A-Z_ (]+"\([^"]+\)"/' \ - $(CURDIR)/src/*.c $(CURDIR)/src/*.h \ - $(CURDIR)/src/s/msdos.h + $(CURDIR)/src/*.c $(CURDIR)/src/*.h cd .. ./bin/etags --include=src/TAGS diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 1fd81ba0e4b..0ed88931691 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -128,8 +128,6 @@ s/\.h\.in/.h-in/ /^DEPFLAGS *=/s/@DEPFLAGS@// /^MKDEPDIR *=/s/@MKDEPDIR@// /^version *=/s/@[^@\n]*@// -/^M_FILE *=/s!@M_FILE@!$(srcdir)/m/intel386.h! -/^S_FILE *=/s!=!= $(srcdir)/s/msdos.h! /^@SET_MAKE@$/s/@SET_MAKE@// /^ [ ]*\$(libsrc)\/make-docfile.*>.*\/DOC/s!make-docfile!make-docfile -o $(etc)/DOC! /^ [ ]*\$(libsrc)\/make-docfile.*>.*gl-tmp/s!make-docfile!make-docfile -o gl-tmp! diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 214480a27ab..25bc5ed12fd 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -26,7 +26,14 @@ #define NSIG 320\ #endif +/^#undef MSDOS *$/c\ +#ifndef MSDOS\ +#define MSDOS\ +#endif +/^#undef DOS_NT *$/s/^.*$/#define DOS_NT/ +/^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/ /^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/ +/^#undef HAVE_INVERSE_HYPERBOLIC *$/s/^.*$/#define HAVE_INVERSE_HYPERBOLIC/ /^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/ /^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/ /^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/ @@ -63,7 +70,7 @@ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ /^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/ -/^#undef VERSION/s/^.*$/#define VERSION "24.1.50"/ +/^#undef VERSION/s/^.*$/#define VERSION "24.2.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ @@ -79,7 +86,17 @@ /^#undef HAVE_SIGNED_SIG_ATOMIC_T *$/s/^.*$/#define HAVE_SIGNED_SIG_ATOMIC_T 1/ /^#undef HAVE_SIGNED_WINT_T *$/s/^.*$/#define HAVE_SIGNED_WINT_T 1/ /^#undef HAVE_UNSIGNED_LONG_LONG_INT *$/s/^.*$/#define HAVE_UNSIGNED_LONG_LONG_INT 1/ -/^#under HAVE_WCHAR_H *$/s/^.*$/#define HAVE_WCHAR_H 1/ +/^#undef HAVE_WCHAR_H *$/s/^.*$/#define HAVE_WCHAR_H 1/ +/^#undef DEVICE_SEP *$/s/^.*$/#define DEVICE_SEP ':'/ +/^#undef IS_DIRECTORY_SEP *$/s,^.*$,#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\\\'), +/^#undef IS_DEVICE_SEP *$/s/^.*$/#define IS_DEVICE_SEP(_c_) ((_c_) == ':')/ +/^#undef IS_ANY_SEP *$/s/^.*$/#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))/ +/^#undef INTERNAL_TERMINAL *$/s,^.*$,#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display::co#80:li#25:Co#16:pa#256:km:ms:cm=:cl=:ce=::se=:so=:us=
    :ue=
:md=:mh=:mb=:mr=:me=::AB=:AF=:op=:", +/^#undef NULL_DEVICE *$/s/^.*$/#define NULL_DEVICE "nul"/ +/^#undef SEPCHAR *$/s/^.*$/#define SEPCHAR '\;'/ +/^#undef USER_FULL_NAME *$/s/^.*$/#define USER_FULL_NAME (getenv ("NAME"))/ +/^#undef _setjmp/s/^.*$/#define _setjmp setjmp/ +/^#undef _longjmp/s/^.*$/#define _longjmp longjmp/ /^#undef inline/s/^.*$/#define inline __inline__/ /^#undef my_strftime/s/^.*$/#define my_strftime nstrftime/ /^#undef restrict/s/^.*$/#define restrict __restrict/ @@ -90,8 +107,6 @@ s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/ s/^#undef EMACS_CONFIGURATION *$/#define EMACS_CONFIGURATION "i386-pc-msdosdjgpp"/ s/^#undef EMACS_CONFIG_OPTIONS *$/#define EMACS_CONFIG_OPTIONS "msdos"/ -s!^#undef config_opsysfile *$!#define config_opsysfile "s/msdos.h"! -s!^#undef config_machfile *$!#define config_machfile "m/intel386.h"! s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/ s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/ /^#undef HAVE_INTTYPES_H/c\ diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index b5b66753bb3..67719cffbd4 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -605,10 +605,10 @@ am__cd = cd s| *sys/select\.h|| s| *sys/time\.h|| } -/^am_libgnu_a_OBJECTS *=/,/^[ ]/{ +/^am_libgnu_a_OBJECTS *=/,/^[^ ]/{ + s/allocator\.\$(OBJEXT) // s/careadlinkat\.\$(OBJEXT) // } -/^am_libgnu_a_OBJECTS *=/s/allocator\.\$(OBJEXT)// /^srcdir *=/s/@[^@\n]*@/./ /^top_srcdir *=/s/@[^@\n]*@/../ /^top_builddir *=/s/@[^@\n]*@/../ diff --git a/nextstep/Cocoa/Emacs.base/Contents/Info.plist b/nextstep/Cocoa/Emacs.base/Contents/Info.plist index 31100020cc3..f5490f613fd 100644 --- a/nextstep/Cocoa/Emacs.base/Contents/Info.plist +++ b/nextstep/Cocoa/Emacs.base/Contents/Info.plist @@ -553,7 +553,7 @@ along with GNU Emacs. If not, see . CFBundleExecutable Emacs CFBundleGetInfoString - Emacs 24.1.50 Copyright (C) 2012 Free Software Foundation, Inc. + Emacs 24.2.50 Copyright (C) 2012 Free Software Foundation, Inc. CFBundleIconFile Emacs.icns CFBundleIdentifier @@ -566,7 +566,7 @@ along with GNU Emacs. If not, see . APPL CFBundleShortVersionString - 24.1.50 + 24.2.50 CFBundleSignature EMAx diff --git a/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings b/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings index cd1920317b0..7655c0ca8ec 100644 --- a/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings +++ b/nextstep/Cocoa/Emacs.base/Contents/Resources/English.lproj/InfoPlist.strings @@ -1,6 +1,6 @@ /* Localized versions of Info.plist keys */ CFBundleName = "Emacs"; -CFBundleShortVersionString = "Version 24.1.50"; -CFBundleGetInfoString = "Emacs version 24.1.50, NS Windowing"; +CFBundleShortVersionString = "Version 24.2.50"; +CFBundleGetInfoString = "Emacs version 24.2.50, NS Windowing"; NSHumanReadableCopyright = "Copyright (C) 2012 Free Software Foundation, Inc."; diff --git a/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop b/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop index 4e79b4f380e..a36eafaadb0 100644 --- a/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop +++ b/nextstep/GNUstep/Emacs.base/Resources/Emacs.desktop @@ -1,7 +1,7 @@ [Desktop Entry] Encoding=UTF-8 Type=Application -Version=24.1.50 +Version=24.2.50 Categories=GNUstep Name=Emacs Comment=GNU Emacs for NeXT/Open/GNUstep and OS X diff --git a/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist b/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist index e22b9daa373..6cde01b0d05 100644 --- a/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist +++ b/nextstep/GNUstep/Emacs.base/Resources/Info-gnustep.plist @@ -2,7 +2,7 @@ ApplicationDescription = "GNU Emacs for GNUstep / OS X"; ApplicationIcon = emacs.tiff; ApplicationName = Emacs; - ApplicationRelease = "24.1.50"; + ApplicationRelease = "24.2.50"; Authors = ( "Adrian Robert (GNUstep)", "Christophe de Dinechin (MacOS X)", @@ -13,7 +13,7 @@ ); Copyright = "Copyright (C) 2012 Free Software Foundation, Inc."; CopyrightDescription = "Released under the GNU General Public License Version 3 or later"; - FullVersionID = "Emacs 24.1.50, NS Windowing"; + FullVersionID = "Emacs 24.2.50, NS Windowing"; NSExecutable = Emacs; NSIcon = emacs.tiff; NSPrincipalClass = NSApplication; diff --git a/nt/ChangeLog b/nt/ChangeLog index 5e6b3146e1d..4727950b9a9 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,66 @@ +2012-08-14 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (_GL_INLINE_HEADER_BEGIN): Update. + +2012-08-10 Glenn Morris + + * config.nt (DIRECTORY_SEP): Move here from src/lisp.h. + +2012-08-07 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (BROKEN_GETWD, DISPNEW_NEEDS_STDIO_EXT): New macros. + (PENDING_OUTPUT_COUNT): Move definition to inc/ms-w32.h. + + * inc/ms-w32.h (PENDING_OUTPUT_COUNT): Define. + +2012-08-06 Glenn Morris + + * config.nt (GNU_LIBRARY_PENDING_OUTPUT_COUNT): Remove. + (PENDING_OUTPUT_COUNT): Define it as dispnew.c used to. + +2012-08-04 Eli Zaretskii + + * paths.h (PATH_LOADSEARCH, PATH_SITELOADSEARCH, PATH_EXEC) + (PATH_DATA, PATH_DOC): Replace dummy directory names with + directories relative to %emacs_dir%. + (PATH_EXEC): Add lib-src/oo-spd/i386 and lib-src/oo/i386, to cater + to the use case of running un-installed Emacs. + +2012-08-03 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (DOS_NT, MSDOS): New macros. + (WRETCODE, wait3): Remove. + + * inc/ms-w32.h (DOS_NT): Remove; defined in config.nt. + +2012-08-03 Eli Zaretskii + + * inc/sys/stat.h (S_IFLNK): Define. + (S_ISLNK): A non-trivial definition. + (lstat): Prototype instead of a macro that redirects to 'stat'. + +2012-08-02 Paul Eggert + + Use C99-style 'extern inline' if available. + * config.nt: Sync with autogen/config.in. + (_GL_INLINE, _GL_EXTERN_INLINE, _GL_INLINE_HEADER_BEGIN) + (_GL_INLINE_HEADER_END): New macros. + +2012-08-02 Glenn Morris + + * inc/ms-w32.h: Move here from ../src/s. + * config.nt (config_opsysfile): Change to . + +2012-08-01 Juanma Barranquero + + * config.nt: Sync with autogen/config.in. + (DEVICE_SEP, FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC) + (INTERNAL_TERMINAL, IS_ANY_SEP, IS_DEVICE_SEP, IS_DIRECTORY_SEP): + New macros. + 2012-08-01 Juanma Barranquero * config.nt: Sync with autogen/config.in. diff --git a/nt/config.nt b/nt/config.nt index 37d0009c750..b07c04d92e2 100644 --- a/nt/config.nt +++ b/nt/config.nt @@ -1,7 +1,6 @@ /* GNU Emacs site configuration template file. -Copyright (C) 1988, 1993-1994, 2001-2012 - Free Software Foundation, Inc. +Copyright (C) 1988, 1993-1994, 2001-2012 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -22,7 +21,7 @@ along with GNU Emacs. If not, see . */ This file is intentionally kept in sync with autogen/config.in to ease maintenance. Please do not remove non-Windows related stuff unless strictly necessary. Also, before adding anything here - consider whether src/s/ms-w32.h would be a better place; this is + consider whether inc/ms-w32.h would be a better place; this is particularly true for gcc vs. MSVC conditional defines, MinGW or MSVC specific code, and macros not already defined in config.in. */ @@ -58,6 +57,9 @@ along with GNU Emacs. If not, see . */ /* Define if FIONREAD should not be used. */ #undef BROKEN_FIONREAD +/* Define if getwd should not be used. */ +#undef BROKEN_GETWD + /* Define if get_current_dir_name should not be used. */ #undef BROKEN_GET_CURRENT_DIR_NAME @@ -122,14 +124,26 @@ along with GNU Emacs. If not, see . */ /* Name of the default sound device. */ #undef DEFAULT_SOUND_DEVICE +/* Character that separates a device in a file name. */ +#define DEVICE_SEP ':' + /* Define to 1 for DGUX with . */ #undef DGUX +/* Character that separates directories in a file name. */ +#define DIRECTORY_SEP '/' + +/* Define if dispnew.c should include stdio_ext.h. */ +#undef DISPNEW_NEEDS_STDIO_EXT + /* Define if process.c does not need to close a pty to make it a controlling terminal (it is already a controlling terminal of the subprocess, because we did ioctl TIOCSCTTY). */ #undef DONT_REOPEN_PTY +/* Define if the system is MS DOS or MS Windows. */ +#define DOS_NT + /* Define to 1 if you are using the GNU C Library. */ #undef DOUG_LEA_MALLOC @@ -147,6 +161,10 @@ along with GNU Emacs. If not, see . */ */ #define FIRST_PTY_LETTER 'a' +/* Define if the float library doesn't handle errors by either setting errno, + or signaling SIGFPE/SIGILL. */ +#undef FLOAT_CHECK_DOMAIN + /* Define to 1 if futimesat mishandles a NULL file name. */ #undef FUTIMESAT_NULL_BUG @@ -201,9 +219,6 @@ along with GNU Emacs. If not, see . */ whether the gnulib module scanf shall be considered present. */ #undef GNULIB_SCANF -/* Value of PENDING_OUTPUT_COUNT if using the GNU C library. */ -#undef GNU_LIBRARY_PENDING_OUTPUT_COUNT - /* Define if ths system is compatible with GNU/Linux. */ #undef GNU_LINUX @@ -524,6 +539,9 @@ along with GNU Emacs. If not, see . */ /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H +/* Define if you have the functions acosh, asinh, and atanh. */ +#undef HAVE_INVERSE_HYPERBOLIC + /* Define to 1 if you have the jpeg library (-ljpeg). */ #undef HAVE_JPEG @@ -1102,12 +1120,24 @@ along with GNU Emacs. If not, see . */ /* Define if the system is HPUX. */ #undef HPUX +/* This is substituted when $TERM is "internal". */ +#undef INTERNAL_TERMINAL + /* Define to read input using SIGIO. */ #undef INTERRUPT_INPUT /* Define if the system is IRIX. */ #undef IRIX6_5 +/* Returns true if character is any form of separator. */ +#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) + +/* Returns true if character is a device separator. */ +#define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP) + +/* Returns true if character is a directory separator. */ +#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') + /* Define to support Kerberos-authenticated POP mail retrieval. */ #undef KERBEROS @@ -1139,6 +1169,9 @@ along with GNU Emacs. If not, see . */ /* Define to support POP mail retrieval. */ #define MAIL_USE_POP 1 +/* Define if the system is MS DOS. */ +#undef MSDOS + /* Define if system's imake configuration file defines `NeedWidePrototypes' as `NO'. */ #undef NARROWPROTO @@ -1380,7 +1413,7 @@ along with GNU Emacs. If not, see . */ #undef USG_SUBTTY_WORKS /* Version number of package */ -#define VERSION "24.1.50" +#define VERSION "24.2.50" /* Define to l, ll, u, ul, ull, etc., as suitable for constants of type 'wchar_t'. */ @@ -1405,9 +1438,6 @@ along with GNU Emacs. If not, see . */ # endif #endif -/* Some platforms redefine this. */ -#undef WRETCODE - /* Define this to check for malloc buffer overrun. */ #undef XMALLOC_OVERRUN_CHECK @@ -1514,8 +1544,39 @@ along with GNU Emacs. If not, see . */ /* Some platforms redefine this. */ #undef _setjmp -/* Define to the used os dependent file. */ -#define config_opsysfile "s/ms-w32.h" +/* Some platforms that do not use configure define this to include extra + configuration information. */ +#define config_opsysfile + +/* _GL_INLINE is a portable alternative to ISO C99 plain 'inline'. + _GL_EXTERN_INLINE is a portable alternative to 'extern inline'. + _GL_INLINE_HEADER_BEGIN contains useful stuff to put + in an include file, before uses of _GL_INLINE. + It suppresses GCC's bogus "no previous prototype for 'FOO'" diagnostic, + when FOO is an inline function in the header; see + . + _GL_INLINE_HEADER_END contains useful stuff to put + in the same include file, after uses of _GL_INLINE. */ +#if __GNUC__ ? __GNUC_STDC_INLINE__ : 199901L <= __STDC_VERSION__ +# define _GL_INLINE inline +# define _GL_EXTERN_INLINE extern inline +# if (__GNUC__ == 4 && 6 <= __GNUC_MINOR__) || 4 < __GNUC__ +# define _GL_INLINE_HEADER_BEGIN \ + _Pragma ("GCC diagnostic push") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-prototypes\"") \ + _Pragma ("GCC diagnostic ignored \"-Wmissing-declarations\"") +# define _GL_INLINE_HEADER_END \ + _Pragma ("GCC diagnostic pop") +# endif +#else +# define _GL_INLINE static inline +# define _GL_EXTERN_INLINE static inline +#endif + +#ifndef _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_BEGIN +# define _GL_INLINE_HEADER_END +#endif /* A replacement for va_copy, if needed. */ #define gl_va_copy(a,b) ((a) = (b)) @@ -1619,9 +1680,6 @@ along with GNU Emacs. If not, see . */ /* Define as `fork' if `vfork' does not work. */ #undef vfork -/* Some platforms redefine this. */ -#undef wait3 - #include #endif /* EMACS_CONFIG_H */ diff --git a/nt/emacs.rc b/nt/emacs.rc index 7a6b00ef2a8..b45c57bf60b 100644 --- a/nt/emacs.rc +++ b/nt/emacs.rc @@ -7,8 +7,8 @@ Emacs ICON icons\emacs.ico #endif VS_VERSION_INFO VERSIONINFO - FILEVERSION 24,1,50,0 - PRODUCTVERSION 24,1,50,0 + FILEVERSION 24,2,50,0 + PRODUCTVERSION 24,2,50,0 FILEFLAGSMASK 0x3FL #ifdef EMACSDEBUG FILEFLAGS 0x1L @@ -25,12 +25,12 @@ BEGIN BEGIN VALUE "CompanyName", "Free Software Foundation\0" VALUE "FileDescription", "GNU Emacs: The extensible self-documenting text editor\0" - VALUE "FileVersion", "24, 1, 50, 0\0" + VALUE "FileVersion", "24, 2, 50, 0\0" VALUE "InternalName", "Emacs\0" VALUE "LegalCopyright", "Copyright (C) 2001-2012\0" VALUE "OriginalFilename", "emacs.exe" VALUE "ProductName", "Emacs\0" - VALUE "ProductVersion", "24, 1, 50, 0\0" + VALUE "ProductVersion", "24, 2, 50, 0\0" VALUE "OLESelfRegister", "\0" END END diff --git a/nt/emacsclient.rc b/nt/emacsclient.rc index d99b2fcd8fa..e79f1fa4aaa 100644 --- a/nt/emacsclient.rc +++ b/nt/emacsclient.rc @@ -5,8 +5,8 @@ Emacs ICON icons\emacs.ico #endif VS_VERSION_INFO VERSIONINFO - FILEVERSION 24,1,50,0 - PRODUCTVERSION 24,1,50,0 + FILEVERSION 24,2,50,0 + PRODUCTVERSION 24,2,50,0 FILEFLAGSMASK 0x3FL #ifdef EMACSDEBUG FILEFLAGS 0x1L @@ -23,12 +23,12 @@ BEGIN BEGIN VALUE "CompanyName", "Free Software Foundation\0" VALUE "FileDescription", "GNU EmacsClient: Client for the extensible self-documenting text editor\0" - VALUE "FileVersion", "24, 1, 50, 0\0" + VALUE "FileVersion", "24, 2, 50, 0\0" VALUE "InternalName", "EmacsClient\0" VALUE "LegalCopyright", "Copyright (C) 2001-2012\0" VALUE "OriginalFilename", "emacsclientw.exe" VALUE "ProductName", "EmacsClient\0" - VALUE "ProductVersion", "24, 1, 50, 0\0" + VALUE "ProductVersion", "24, 2, 50, 0\0" VALUE "OLESelfRegister", "\0" END END diff --git a/src/s/ms-w32.h b/nt/inc/ms-w32.h similarity index 97% rename from src/s/ms-w32.h rename to nt/inc/ms-w32.h index ca4c1001ec9..022b168c0b8 100644 --- a/src/s/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -23,12 +23,16 @@ along with GNU Emacs. If not, see . */ #ifndef WINDOWSNT #define WINDOWSNT #endif -#ifndef DOS_NT -#define DOS_NT /* MSDOS or WINDOWSNT */ -#endif /* #undef const */ +/* Number of chars of output in the buffer of a stdio stream. */ +#ifdef __GNU_LIBRARY__ +#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer) +#else +#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base) +#endif + /* If you are compiling with a non-C calling convention but need to declare vararg routines differently, put it here. */ #define _VARARGS_ __cdecl @@ -74,13 +78,6 @@ along with GNU Emacs. If not, see . */ your system and must be used only through an encapsulation (which you should place, by convention, in sysdep.c). */ -/* Define this to be the separator between devices and paths. */ -#define DEVICE_SEP ':' - -/* We'll support either convention on NT. */ -#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') -#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) - #ifdef __GNUC__ #ifndef __cplusplus #undef inline diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h index 57fabff4b0c..b673b80a0e3 100644 --- a/nt/inc/sys/stat.h +++ b/nt/inc/sys/stat.h @@ -33,13 +33,14 @@ along with GNU Emacs. If not, see . */ #include #include -#define S_IFMT 0xF000 +#define S_IFMT 0xF800 #define S_IFREG 0x8000 #define S_IFDIR 0x4000 #define S_IFBLK 0x3000 #define S_IFCHR 0x2000 #define S_IFIFO 0x1000 +#define S_IFLNK 0x0800 #define S_IREAD 0x0100 #define S_IWRITE 0x0080 @@ -55,6 +56,7 @@ along with GNU Emacs. If not, see . */ #define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) #define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) #define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) +#define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) /* These don't exist on Windows, but lib/filemode.c wants them. */ #define S_ISUID 0 @@ -68,7 +70,6 @@ along with GNU Emacs. If not, see . */ #define S_IXOTH (S_IXUSR >> 6) #define S_ISSOCK(m) 0 -#define S_ISLNK(m) 0 #define S_ISCTG(p) 0 #define S_ISDOOR(m) 0 #define S_ISMPB(m) 0 @@ -103,9 +104,7 @@ struct stat { _CRTIMP int __cdecl __MINGW_NOTHROW fstat (int, struct stat*); _CRTIMP int __cdecl __MINGW_NOTHROW chmod (const char*, int); _CRTIMP int __cdecl __MINGW_NOTHROW stat (const char*, struct stat*); - -/* fileio.c and dired.c want lstat. */ -#define lstat stat +_CRTIMP int __cdecl __MINGW_NOTHROW lstat (const char*, struct stat*); #endif /* INC_SYS_STAT_H_ */ diff --git a/nt/makefile.w32-in b/nt/makefile.w32-in index fc5ecefd173..cf4af2b14cd 100644 --- a/nt/makefile.w32-in +++ b/nt/makefile.w32-in @@ -22,7 +22,7 @@ # FIXME: This file uses DOS EOLs. Convert to Unix after 22.1 is out # (and remove or replace this comment). -VERSION = 24.1.50 +VERSION = 24.2.50 TMP_DIST_DIR = emacs-$(VERSION) diff --git a/nt/paths.h b/nt/paths.h index d3a41e3c541..801d187646f 100644 --- a/nt/paths.h +++ b/nt/paths.h @@ -18,14 +18,18 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +/* Relative file names in this file that begin with "%emacs_dir%/" are + treated specially by decode_env_path: they are expanded relative to + the value of the emacs_dir environment variable, which points to + the root of the Emacs tree. */ /* The default search path for Lisp function "load". Together with PATH_SITELOADSEARCH, this sets load-path. */ /* #define PATH_LOADSEARCH "/usr/local/lib/emacs/lisp" */ -#define PATH_LOADSEARCH "C:/emacs/lisp" +#define PATH_LOADSEARCH "%emacs_dir%/lisp;%emacs_dir%/leim" /* Like PATH_LOADSEARCH, but contains the non-standard pieces. */ -#define PATH_SITELOADSEARCH "C:/emacs/site-lisp" +#define PATH_SITELOADSEARCH "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp" /* Like PATH_LOADSEARCH, but used only when Emacs is dumping. This path is usually identical to PATH_LOADSEARCH except that the entry @@ -39,13 +43,13 @@ along with GNU Emacs. If not, see . */ variable exec-directory. exec-directory is used for finding executables and other architecture-dependent files. */ /* #define PATH_EXEC "/usr/local/lib/emacs/etc" */ -#define PATH_EXEC "C:/emacs/bin" +#define PATH_EXEC "%emacs_dir%/bin;%emacs_dir%/lib-src/oo-spd/i386;%emacs_dir%/lib-src/oo/i386" /* Where Emacs should look for its architecture-independent data files, like the NEWS file. The lisp variable data-directory is set to this value. */ /* #define PATH_DATA "/usr/local/lib/emacs/data" */ -#define PATH_DATA "C:/emacs/data" +#define PATH_DATA "%emacs_dir%/etc" /* Where Emacs should look for X bitmap files. The lisp variable x-bitmap-file-path is set based on this value. */ @@ -53,11 +57,10 @@ along with GNU Emacs. If not, see . */ /* Where Emacs should look for its docstring file. The lisp variable doc-directory is set to this value. */ -#define PATH_DOC "C:/emacs/etc" +#define PATH_DOC "%emacs_dir%/etc" /* Where the configuration process believes the info tree lives. The lisp variable configure-info-directory gets its value from this macro, and is then used to set the Info-default-directory-list. */ /* #define PATH_INFO "/usr/local/info" */ #define PATH_INFO "C:/emacs/info" - diff --git a/src/.gdbinit b/src/.gdbinit index 4a140af7fd3..c0a1bbfffd8 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -765,7 +765,7 @@ end define xframe xgetptr $ print (struct frame *) $ptr - xgetptr $->name_ + xgetptr $->name set $ptr = (struct Lisp_String *) $ptr xprintstr $ptr echo \n @@ -1047,7 +1047,7 @@ end define xprintsym xgetptr $arg0 set $sym = (struct Lisp_Symbol *) $ptr - xgetptr $sym->xname + xgetptr $sym->name set $sym_name = (struct Lisp_String *) $ptr xprintstr $sym_name end @@ -1218,7 +1218,7 @@ xgetptr globals.f_Vsystem_type # $ptr is NULL in temacs if ($ptr != 0) set $tem = (struct Lisp_Symbol *) $ptr - xgetptr $tem->xname + xgetptr $tem->name set $tem = (struct Lisp_String *) $ptr set $tem = (char *) $tem->data @@ -1241,7 +1241,7 @@ commands silent xgetptr globals.f_Vinitial_window_system set $tem = (struct Lisp_Symbol *) $ptr - xgetptr $tem->xname + xgetptr $tem->name set $tem = (struct Lisp_String *) $ptr set $tem = (char *) $tem->data # If we are running in synchronous mode, we want a chance to look diff --git a/src/.gitignore b/src/.gitignore index 070a38fea54..ebacd571ddd 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -2,6 +2,7 @@ buildobj.h config.h epaths.h stamp_BLD +stamp-h.in oo/ oo-spd/ diff --git a/src/ChangeLog b/src/ChangeLog index a6913d1ad78..6e49dd44fde 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,744 @@ +2012-08-15 Jan Djärv + + * nsmenu.m (popupSession): Remove. + (pop_down_menu): Remove endModalSession. + (timeout_handler:): New method. + (runDialogAt:): Get next timeout. Start a NSTimer with that timeout. + Call runModalForWindow. Check timer_fired when it returns. + If not set, cancel timer and break out of loop. + Otherwise loop again, with a new timeout. + + * nsterm.m: Include fcntl.h if present. + (fd_entry, t_readfds, inNsSelect): Remove. + (select_writefds, select_valid, select_timeout, selfds) + (select_mutex, apploopnr): Add. + (EV_TRAILER): Call kbd_buffer_store_event_hold only if q_event_ptr. + Otherwise call kbd_buffer_store_event. + (ns_send_appdefined): Remove release of fd_entry. + (ns_read_socket): Always send appdefined. Remove inNsSelect check. + Increment and decrement apploopnr. + (ns_select): If no file descriptors, just do a NSTimer. + Otherwise copy read/write masks and start select thread (fd_handler). + Start main loop and wait for application defined event. + Inform select thread to stop selecting after main loop is exited. + (ns_term_init): Create selfds pipe and set non-blocking. + Initialize select_mutex. Start the select thread (fd_handler). + (fd_handler:): Loop forever, wait for info from the main thread + to either start or stop selecting. When select returns, send + and appdefined event. + (sendScrollEventAtLoc:fromEvent:): Check if q_event_ptr is set. + If not call kbd_buffer_store_event. + + * nsterm.h (EmacsApp): fd_handler takes id argument. + (EmacsDialogPanel): Add timer_fired and timeout_handler. + + * gtkutil.c (xg_mark_data): Use FRAME_X_P. + +2012-08-15 Eli Zaretskii + + * region-cache.c (move_cache_gap): Update gap_len using the actual + growth of the boundaries array. Do not change cache_len. + (Bug#12196) + +2012-08-15 Dmitry Antipov + + Generalize and cleanup font subsystem checks. + * font.h (FONT_DEBUG, font_assert): Remove. + * font.c, fontset.c, w32font.c, xfont.c, xftfont.c: Change + font_assert to eassert. Use eassert where appropriate. + +2012-08-15 Dmitry Antipov + + * gtkutil.c (xg_get_font): Use pango_units_to_double. + +2012-08-15 Chong Yidong + + * gtkutil.c (xg_get_font): Rename from xg_get_font_name. When + using the new font chooser, use gtk_font_chooser_get_font_desc to + extract the font descriptor instead of just the font name. In + that case, return a font spec instead of a string. + (x_last_font_name): Move to this file from xfns.c. + + * xfns.c (Fx_select_font): The return value can also be a font + spec. Move x_last_font_name management to gtkutil.c. + + * xfaces.c: Make font weight and style symbols non-static. + +2012-08-15 Stefan Monnier + + * minibuf.c (read_minibuf): Ignore caller's inhibit-read-only + (bug#12117). + +2012-08-14 Stefan Monnier + + * alloc.c (Fgarbage_collect): Use plural form consistently. + +2012-08-14 Eli Zaretskii + + * keyboard.c (command_loop_1): Reset ignore_mouse_drag_p flag each + iteration through the command loop. Fixes a problem whereby mouse + movements are ignored until the first mouse click. + +2012-08-14 Paul Eggert + + Use bool, not int, for Lisp booleans. + This is more natural, and on my platform (GCC 4.7.1 x86-64) it + makes Emacs a bit smaller and presumably a bit faster. + * lisp.h: Include . + (struct Lisp_Boolfwd, defvar_bool): + * lread.c (defvar_bool): Use bool, not int, for Lisp booleans. + * regex.c [!emacs]: Include . + (false, true): Remove; does this for us now. + +2012-08-14 Chong Yidong + + * character.c (Fcharacterp): Doc fix (Bug#12076). + + * data.c (Findirect_variable): Doc fix (Bug#11040). + + * chartab.c (Fmap_char_table): Doc fix (Bug#12061). + + * editfns.c (Fformat): Doc fix (Bug#12059). + (Fsave_current_buffer): Doc fix (Bug#11542). + +2012-08-14 Barry OReilly (tiny change) + + * keyboard.c (access_keymap_keyremap): Accept anonymous functions + (bug#12022). + +2012-08-14 Martin Rudalics + + * frame.c (make_frame_without_minibuffer, make_minibuffer_frame) + (delete_frame, Fmake_frame_invisible, Ficonify_frame): + * minibuf.c (choose_minibuf_frame, read_minibuf): + * w32fns.c (x_create_tip_frame): + * xfns.c (x_create_tip_frame): Call set_window_buffer instead of + Fset_window_buffer (Bug#11984, Bug#12025, Bug#12026). + +2012-08-14 Paul Eggert + + * intervals.c (offset_intervals): Remove obsolete comment. + +2012-08-14 Andreas Schwab + + * gtkutil.c (find_rtl_image, update_frame_tool_bar): Use NILP. + +2012-08-14 Gergely Risko + + * coding.c (decode_coding): Record buffer modification before + disabling undo_list (Bug#11773). + +2012-08-14 Dmitry Antipov + + Revert and cleanup some recent overlay changes. + * buffer.h (enum overlay_type): Remove. + (buffer_get_overlays, buffer_set_overlays): Likewise. + (buffer_set_overlays_before, buffer_set_overlays_after): + New function. Adjust users. + (unchain_both): Add eassert. + +2012-08-14 Dmitry Antipov + + * gtkutil.c (update_frame_tool_bar): Use EQ where appropriate. + +2012-08-14 Paul Eggert + + * gtkutil.c (xg_mark_data): Don't assume C99. + +2012-08-13 Jan Djärv + + * gtkutil.c (xg_frame_tb_info): New struct. + (TB_INFO_KEY): New define. + (xg_free_frame_widgets): Free xg_frame_tb_info for frame if present. + (xg_mark_data): Mark Lisp_Objects in xg_frame_tb_info. + (xg_create_tool_bar): Allocate and initialize a xg_frame_tb_info + if not present. + (update_frame_tool_bar): Return early if data in xg_frame_tb_info + is up to date. Otherwise store new data. + (free_frame_tool_bar): Free xg_frame_tb_info if present. + +2012-08-13 Dmitry Antipov + + Use KSET for write access to Lisp_Object members of struct kboard. + * keyboard.h (KSET): New macro. + * callint.c, category.c, frame.c, keyboard.c, keyboard.h, macros.c: + * msdos.c, nsfns.m, nsterm.m, term.c, w32fns.c, w32term.c, xfns.c: + * xterm.c: Adjust users. + +2012-08-13 Dmitry Antipov + + Use BSET for write access to Lisp_Object members of struct buffer. + * buffer.h (BSET): New macro. + * buffer.c, casetab.c, cmds.c, coding.c, data.c, editfns.c: + * fileio.c, frame.c, indent.c, insdel.c, intervals.c, keymap.c: + * minibuf.c, print.c, process.c, syntax.c, undo.c, w32fns.c: + * window.c, xdisp.c, xfns.c: Adjust users. + +2012-08-11 BT Templeton (tiny change) + + * lread.c (syms_of_lread): Initialize Vlexical_binding. + +2012-08-11 Jan Djärv + + * nsterm.m (not_in_argv): New function. + (application:openFile, application:openTempFile:): + (application:openFileWithoutUI:, application:openFiles:): Open file + if not_in_argv returns non-zero (bug#12171). + + * gtkutil.c (gtk_font_chooser_dialog_new, GTK_FONT_CHOOSER) + (gtk_font_chooser_set_font, gtk_font_chooser_get_font): + Define for Gtk+ versions less than 3.2. + (xg_get_font_name): Use those functions/macros here. + Reported by Frans Oilinki . + +2012-08-11 YAMAMOTO Mitsuharu + + * unexmacosx.c (copy_data_segment): Copy initialized data in + statically linked libraries from input file rather than memory. + + * unexmacosx.c (print_load_command_name): Add cases LC_MAIN, + LC_SOURCE_VERSION, and LC_DYLIB_CODE_SIGN_DRS. + (dump_it) [LC_DYLIB_CODE_SIGN_DRS]: Call copy_linkedit_data. + +2012-08-10 Glenn Morris + + * conf_post.h (IF_LINT, lint_assume): Move here from lisp.h. + * lisp.h (IF_LINT, lint_assume): Move to conf_post.h. + +2012-08-10 Dmitry Antipov + + Fix last change to allow compilation with low optimization levels. + * intervals.c (INTERVALS_INLINE): Define to EXTERN_INLINE. + Reported by Jan Djärv . + +2012-08-10 Dmitry Antipov + + Use common inline syntax in intervals.h. + * intervals.h (INTERVALS_INLINE): New macro. + Change all users from LISP_INLINE. + +2012-08-10 Dmitry Antipov + + Define Qnone once for all platforms. + * frame.c (Qnone): Define here. + (syms_of_frame): DEFSYM it. + * lisp.h (Qnone): New declaration. + * nsfns.m, nsterm.h, nsterm.m, w32fns.c, w32font.c: + * xfns.c: Remove duplication. Adjust users. + +2012-08-10 Dmitry Antipov + + Remove unused macros from intervals.h. + * intervals.h (MERGE_INSERTIONS, DISPLAY_INVISIBLE_GLYPH): Remove. + * intervals.c: Adjust comment. + +2012-08-10 Eli Zaretskii + + * w32fns.c : New static variable. + (globals_of_w32fns): Initialize it according to os_subtype. + (w32_init_class, w32_msg_pump, w32_wnd_proc): Use it instead of + testing os_subtype. + +2012-08-10 Joakim Hårsman (tiny change) + Eli Zaretskii + + Fix bug #10299 with Unicode characters sent by customized + keyboards created by MSKLC. + * w32fns.c (INIT_WINDOW_CLASS): New macro. + (w32_init_class): Use it to initialize the Emacs class with either + ANSI or Unicode API calls. + (w32_msg_pump): Call GetMessageW and DispatchMessageW on NT and + later. + (w32_wnd_proc): If the character code sent by WM_CHAR or + WM_SYSCHAR is above 255, post a WM_UNICHAR message, not the + original message. Call DefWindowProcW on NT and later. + +2012-08-10 Glenn Morris + + * Makefile.in (config_h): Fix conf_post.h out-of-tree build location. + + * lisp.h (DIRECTORY_SEP): Let configure set it. + +2012-08-09 Dmitry Antipov + + Use TSET for write access to Lisp_Object slots of struct terminal. + * termhooks.h (TSET): New macro. + * coding.c, terminal.c, xselect.c: Adjust users. + +2012-08-08 Stefan Monnier + + * xdisp.c (safe_eval_handler): Remove prototype. Receive args describing + the failing expression, include them in the error message. + * eval.c (internal_condition_case_n): Pass nargs and args to hfun. + * lisp.h (internal_condition_case_n): Update declaration. + +2012-08-08 Dmitry Antipov + + Inline functions to examine and change buffer overlays. + * buffer.c (unchain_both): New function. + * buffer.h (buffer_get_overlays, buffer_set_overlays): + (buffer_has_overlays): New function. + (enum overlay_type): New enum. + * alloc.c, buffer.c, editfns.c, fileio.c, indent.c: + * insdel.c, intervals.c, print.c, xdisp.c: Adjust users. + +2012-08-08 Dmitry Antipov + + Inline functions to examine and change buffer intervals. + * alloc.c (mark_interval_tree): Remove. + (MARK_INTERVAL_TREE): Simplify. + (UNMARK_BALANCE_INTERVALS): Remove. Adjust users. + * intervals.c (buffer_balance_intervals): New function. + (graft_intervals_into_buffer): Adjust indentation. + (set_intervals_multibyte): Simplify. + * buffer.h (BUF_INTERVALS): Remove. + (buffer_get_intervals, buffer_set_intervals): New function. + * alloc.c, buffer.c, editfns.c, fileio.c, indent.c, insdel.c: + * intervals.c, textprop.c: Adjust users. + +2012-08-08 Dmitry Antipov + + Inline functions to examine and change string intervals. + * lisp.h (STRING_INTERVALS, STRING_SET_INTERVALS): Remove. + (string_get_intervals, string_set_intervals): New function. + * alloc.c, buffer.c, editfns.c, fns.c, insdel.c, intervals.c: + * lread.c, print.c, textprop.c: Adjust users. + +2012-08-08 Glenn Morris + + * lisp.mk (lisp): Remove language/persian.elc. + +2012-08-08 Dmitry Antipov + + Cleanup intervals. + * intervals.h (NULL_INTERVAL, DEFAULT_INTERVAL): Remove. + (NULL_INTERVAL_P): Likewise. Adjust users. + (FRONT_STICKY_P, END_NONSTICKY_P, FRONT_NONSTICKY_P): + Adjust comment. Move under #if 0. + * alloc.c, buffer.c, editfns.c, fns.c, insdel.c, intervals.c: + * print.c, syntax.c, textprop.c, xdisp.c: Adjust users. + +2012-08-08 Dmitry Antipov + + Check total length of intervals with eassert. + * intervals.h (CHECK_TOTAL_LENGTH): Remove. + * intervals.c: Change all users to eassert. + +2012-08-07 Eli Zaretskii + + * .gdbinit (xframe, xwindow, nextcons, xcar, xcdr, xlist): + Rename fields to match removal of FGET and WGET and disuse of + INTERNAL_FIELD in Lisp_Cons. + +2012-08-07 Dmitry Antipov + + Revert and cleanup Lisp_Cons, Lisp_Misc and Lisp_Symbol things. + * lisp.h (struct Lisp_Symbol): Change xname to meaningful + name since all xname users are fixed long time ago. Do not + use INTERNAL_FIELD. + (set_symbol_name, set_symbol_function, set_symbol_plist): + (set_symbol_next, set_overlay_plist): New function. + (struct Lisp_Cons): Do not use INTERNAL_FIELD. + (struct Lisp_Overlay): Likewise. + (CVAR, MVAR, SVAR): Remove. + * alloc.c, buffer.c, buffer.h, bytecode.c, cmds.c, data.c: + * doc.c, eval.c, fns.c, keyboard.c, lread.c, nsselect.m: + * xterm.c: Adjust users. + * .gdbinit: Change to use name field of struct Lisp_Symbol + where appropriate. + +2012-08-07 Dmitry Antipov + + Basic functions to set Lisp_Object and pointer slots of intervals. + * intervals.h (interval_set_parent, interval_set_object): + (interval_set_left, interval_set_right, interval_set_plist): + (interval_copy_parent): New function. + (SET_INTERVAL_OBJECT, SET_INTERVAL_PARENT, INTERVAL_PTR_SIZE): Remove. + (RESET_INTERVAL, COPY_INTERVAL_CACHE, MERGE_INTERVAL_CACHE): + Adjust indentation. + (INTERVAL_SIZE): Remove. Adjust users. + * alloc.c, intervals.c, lread.c, textprop.c: Use new functions. + +2012-08-07 Dmitry Antipov + + Drop PGET and revert read access to Lisp_Objects slots of Lisp_Process. + * process.h (PGET): Remove. + (struct Lisp_Process): Do not use INTERNAL_FIELD. + * gnutls.c, print.c, process.c, sysdep.c, w32.c, xdisp.c: Adjust users. + +2012-08-07 Dmitry Antipov + + Drop WGET and revert read access to Lisp_Objects slots of struct window. + * window.h (WGET): Remove. + (struct window): Do not use INTERNAL_FIELD. + * alloc.c, buffer.c, composite.c, dispextern.h, dispnew.c, editfns.c: + * fileio.c, font.c, fontset.c, frame.c, frame.h, fringe.c, indent.c: + * insdel.c, keyboard.c, keymap.c, lisp.h, minibuf.c, msdos.c, nsfns.m: + * nsmenu.m, nsterm.m, print.c, textprop.c, w32fns.c, w32menu.c: + * w32term.c, window.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: + Adjust users. + +2012-08-07 Chong Yidong + + * window.c (Fwindow_edges, Fwindow_pixel_edges) + (Fwindow_absolute_pixel_edges, Fdelete_other_windows_internal) + (Fdelete_window_internal): Signal an error if the window is not on + a live frame (Bug#12025). + +2012-08-07 Dmitry Antipov + + Drop FGET and revert read access to Lisp_Objects slots of struct frame. + * frame.h (FGET): Remove. + (struct frame): Do not use INTERNAL_FIELD. + * buffer.c, data.c, dispnew.c, dosfns.c, eval.c, fontset.c, frame.c: + * fringe.c, gtkutil.c, minibuf.c, msdos.c, nsfns.m, nsmenu.m, nsterm.m: + * print.c, term.c, w32fns.c, w32menu.c, w32term.c, window.c, window.h: + * xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Adjust users. + +2012-08-06 Juanma Barranquero + + * w32.c: Silence compiler warnings. + (map_w32_filename): Remove unused variable `is_fat'. + (chase_symlinks): Add parentheses around expression. + +2012-08-06 Glenn Morris + + * sysdep.c: Respect BROKEN_GETWD. + + * dispnew.c (GNU_LIBRARY_PENDING_OUTPUT_COUNT, PENDING_OUTPUT_COUNT): + Let configure handle it. + (stdio_ext.h) [DISPNEW_NEEDS_STDIO_EXT]: Include it. + +2012-08-06 Dmitry Antipov + + Use GCALIGNMENT where appropriate. + * alloc.c (XMALLOC_HEADER_ALIGNMENT, roundup_size): + (union aligned_Lisp_Symbol, union aligned_Lisp_Misc): + (mark_maybe_pointer, pure_alloc): Change to use GCALIGNMENT. + +2012-08-06 Eli Zaretskii + + * w32menu.c (set_frame_menubar, initialize_frame_menubar): + Don't use FRAME_MENU_BAR_ITEMS as an lvalue. + +2012-08-06 Stefan Monnier + + * buffer.h (struct buffer): Revert `indirections' to a simple int; + that should be sufficient for everyone. + +2012-08-06 Jan Djärv + + * keyboard.c (timer_check_2): Add break so timer_check returns next + timeout. + +2012-08-06 Dmitry Antipov + + Fix Windows build errors introduced after converting to WGET and WSET. + * w32term.c (w32_set_vertical_scroll_bar): Change to use WSET. + Reported by Andy Moreton . + +2012-08-06 Jan Djärv + + * nsterm.m (ns_frame_rehighlight): Use FSET. + + * nsmenu.m (ns_update_menubar): Use FSET. + +2012-08-06 Dmitry Antipov + + Separate read and write access to Lisp_Object slots of Lisp_Process. + * process.h (PGET, PSET): New macros similar to AREF and ASET. + * gnutls.c, print.c, process.c, sysdep.c, w32.c, xdisp.c: Adjust users. + +2012-08-06 Dmitry Antipov + + Separate read and write access to Lisp_Object slots of struct window. + * window.h (WGET, WSET): New macros similar to AREF and ASET. + * alloc.c, buffer.c, composite.c, dispextern.h, dispnew.c, editfns.c: + * fileio.c, font.c, fontset.c, frame.c, frame.h, fringe.c, indent.c: + * insdel.c, keyboard.c, keymap.c, lisp.h, minibuf.c, msdos.c, nsfns.m: + * nsmenu.m, nsterm.m, print.c, textprop.c, w32fns.c, w32menu.c: + * w32term.c, window.c, xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: + Adjust users. + +2012-08-06 Dmitry Antipov + + Fix Windows build errors introduced after converting to FGET and FSET. + * w32term.c (x_frame_rehighlight, x_scroll_bar_create): + (w32_condemn_scroll_bars, w32_redeem_scroll_bar): + (w32_judge_scroll_bars): Change to use FSET. + Reported by Andy Moreton . + +2012-08-06 Dmitry Antipov + + Fix replacement typo. + * window.c (replace_window): Set root_window instead of + selected_window. This fixes a total window subsystem + malfunction reported by Bastien Guerry . + +2012-08-06 Glenn Morris + + * lisp.mk (lisp): Add language/persian.elc. + +2012-08-06 Dmitry Antipov + + Separate read and write access to Lisp_Object slots of struct frame. + * frame.h (FGET, FSET): New macros similar to AREF and ASET. + * buffer.c, data.c, dispnew.c, dosfns.c, eval.c, fontset.c, frame.c: + * fringe.c, gtkutil.c, minibuf.c, msdos.c, nsfns.m, nsmenu.m, nsterm.m: + * print.c, term.c, w32fns.c, w32menu.c, w32term.c, window.c, window.h: + * xdisp.c, xfaces.c, xfns.c, xmenu.c, xterm.c: Adjust users. + +2012-08-05 Andreas Schwab + + * emacs.c (decode_env_path): Only use defaulted if WINDOWSNT. + +2012-08-05 Dmitry Antipov + + Generalize common compile-time constants. + * lisp.h (header_size, bool_header_size, word_size): Now here. + (struct Lisp_Vector): Add comment. + (struct Lisp_Bool_Vector): Move up to define handy constants. + (VECSIZE, PSEUDOVECSIZE): Simplify. + (SAFE_ALLOCA_LISP): Use new constant. Adjust indentation. + * buffer.c, buffer.h, bytecode.c, callint.c, eval.c, fns.c: + * font.c, fontset.c, keyboard.c, keymap.c, macros.c, menu.c: + * msdos.c, w32menu.c, w32term.h, window.c, xdisp.c, xfaces.c: + * xfont.c, xmenu.c: Use word_size where appropriate. + +2012-08-05 Lawrence Mitchell + + * search.c (Freplace_match): Treat \? in the replacement text + literally (Bug#8161). + +2012-08-05 Chong Yidong + + * term.c (Vsuspend_tty_functions, Vresume_tty_functions): + * frame.c (Vdelete_frame_functions): + * emacs.c (Vkill_emacs_hook): Doc fix. + +2012-08-04 Eli Zaretskii + + * xfns.c (x_set_menu_bar_lines): Fix compilation error in + --with-x-toolkit=no builds. + Reported by Carsten Mattner . + +2012-08-04 Chong Yidong + + * syntax.c (Fmodify_syntax_entry): Doc fix. + +2012-08-04 Eli Zaretskii + + Fix startup warnings about ../site-lisp on MS-Windows. (Bug#11959) + * w32.c (init_environment): Change the default values of many + environment variables in dflt_envvars[] to NULL, to avoid pushing + them into environment when they were not already defined. + Remove the code that deletes site-lisp subdirectories from the default + value of EMACSLOADPATH, as it is no longer needed. + (check_windows_init_file): Now external, not static. + Use Vload_path as is, without adding anything, as this function is now + called when Vload_path is already set up. + + * w32.h (check_windows_init_file): Add prototype. + + * emacs.c (init_cmdargs) [WINDOWSNT]: When running from the build + directory, ignore the /*/i386/ tail in Vinvocation_directory, for + compatibility with Posix platforms. + (main): Move the call to check_windows_init_file to here from + w32.c. + (decode_env_path) [WINDOWSNT]: Expand the %emacs_dir%/ prefix, if + any, in the DEFALT argument into the root of the Emacs build or + installation tree, as appropriate. + + * callproc.c (init_callproc_1): Call decode_env_path instead of + doing its equivalent by hand. + (init_callproc): Replace DOS_NT condition with MSDOS, thus letting + the code that sets Vexec_path run on MS-Windows. + + * lread.c (init_lread): Add comments to #ifdef's. + + * msdos.c (dos_set_window_size, IT_update_begin) + (IT_frame_up_to_date, IT_set_frame_parameters): Use FVAR and WVAR + instead of direct references. + +2012-08-04 Paul Eggert + + Export DEFAULT_REHASH_* to GDB. + * lisp.h (DEFAULT_REHASH_THRESHOLD, DEFAULT_REHASH_SIZE): + Now constants, not macros. + +2012-08-03 Paul Eggert + + Remove unnecessary casts involving pointers. + These casts are no longer needed now that we assume C89 or later, + since they involve casting to or from void *. + * alloc.c (make_pure_string, make_pure_c_string, pure_cons) + (make_pure_float, make_pure_vector): + * lisp.h (SAFE_ALLOCA, SAFE_ALLOCA_LISP): + * macros.c (Fstart_kbd_macro): + * menu.c (find_and_return_menu_selection): + * minibuf.c (read_minibuf_noninteractive): + * sysdep.c (closedir): + * xdisp.c (x_produce_glyphs): + * xfaces.c (compare_fonts_by_sort_order): + * xfns.c (x_real_positions, select_visual): + * xselect.c (x_stop_queuing_selection_requests) + (x_get_window_property, x_get_window_property_as_lisp_data): + * xterm.c (x_set_frame_alpha, x_find_modifier_meanings): + Remove unnecessary pointer casts. + * alloc.c (record_xmalloc): New function. + * lisp.h (record_xmalloc): New decl. + (SAFE_ALLOCA): Now takes just one arg -- the size -- and acts + more like a function. This is because the pointer cast is not + needed. All uses changed. + * print.c (print_string, print_error_message): Avoid length recalc. + + Improve fix for macroexp crash with debugging (Bug#12118). + * lisp.h (ASET) [ENABLE_CHECKING]: Pay attention to + ARRAY_MARK_FLAG when checking subscripts, because ASET is + not supposed to be invoked from the garbage collector. + See Andreas Schwab in . + (gc_aset): New function, which is like ASET but can be + used in the garbage collector. + (set_hash_key, set_hash_value, set_hash_next, set_hash_hash) + (set_hash_index): Use it instead of ASET. + +2012-08-03 Eli Zaretskii + + Support symlinks on latest versions of MS-Windows. + * w32.c: Include winioctl.h and aclapi.h. + (is_symlink, chase_symlinks, enable_privilege, restore_privilege) + (revert_to_self): Forward declarations of static functions. + : + : New static flags. + (globals_of_w32): Initialize them to zero. + (GetSecurityInfo_Proc, CreateSymbolicLink_Proc): New typedefs. + (map_w32_filename): Improve commentary. Simplify switch. + (SYMBOLIC_LINK_FLAG_DIRECTORY): Define if not defined in system + headers (most versions of MinGW w32api don't). + (get_security_info, create_symbolic_link) + (get_file_security_desc_by_handle, is_symlink, chase_symlinks): + New functions. + (sys_access, sys_chmod): Call 'chase_symlinks' to resolve symlinks + in the argument file name. + (sys_access): Call unc_volume_file_attributes only if + GetFileAttributes fails with network-related error codes. + (sys_rename): Diagnose renaming of a symlink when the user doesn't + have the required privileges. + (get_file_security_desc_by_name): Rename from + get_file_security_desc. + (stat_worker): New function, with most of the guts of 'stat', and + with addition of handling of symlinks and support for 'lstat'. + If possible, get file's attributes and security information by + handle, not by name. Produce S_IFLNK bit for symlinks, when + called from 'lstat'. + (stat, lstat): New functions, call 'stat_worker'. + (symlink, readlink, careadlinkat): Rewritten to create and resolve + symlinks when the underlying filesystem supports them. + +2012-08-02 Paul Eggert + + Fix macroexp crash on Windows with debugging (Bug#12118). + * lisp.h (ASET) [ENABLE_CHECKING]: Ignore ARRAY_MARK_FLAG when + checking subscripts; problem introduced with the recent + "ASET (a, i, v)" rather than "AREF (a, i) = v" patch. + (ARRAY_MARK_FLAG): Now a macro as well as a constant, + since it's used in non-static inline functions now. + + * xfaces.c (face_at_buffer_position, face_for_overlay_string): + Don't assume buffer size fits in 'int'. Remove unused local. + + Use C99-style 'extern inline' if available. + * buffer.h (BUFFER_INLINE): + * category.h (CATEGORY_INLINE): + * character.h (CHARACTER_INLINE): + * charset.h (CHARSET_INLINE): + * composite.h (COMPOSITE_INLINE): + * dispextern.h (DISPEXTERN_INLINE): + * lisp.h (LISP_INLINE): + * systime.h (SYSTIME_INLINE): + New macro, replacing 'static inline' in this header. + * buffer.h, category.h, character.h, charset.h, composite.h: + * dispextern.h, lisp.h, systime.h: + Use INLINE_HEADER_BEGIN, INLINE_HEADER_END. + * alloc.c (LISP_INLINE): + * buffer.c (BUFFER_INLINE): + * category.c (CATEGORY_INLINE): + * character.c (CHARACTER_INLINE): + * charset.c (CHARSET_INLINE): + * composite.c (COMPOSITE_INLINE): + * dispnew.c (DISPEXTERN_INLINE): + * sysdep.c (SYSTIME_INLINE): + Define to EXTERN_INLINE, so that the corresponding functions + are compiled into code. + * conf_post.h (INLINE, EXTERN_INLINE, INLINE_HEADER_BEGIN) + (INLINE_HEADER_END): New macros. + * lisp.h (PSEUDOVECTOR_FLAG): Now a macro as well as a constant, + since it's used in non-static inline functions now. + (VALMASK) [!USE_LSB_TAG]: Likewise. + +2012-08-02 Glenn Morris + + * s/: Remove empty directory. + + * s/ms-w32.h: Move to ../nt/inc. + * makefile.w32-in (TAGS, TAGS-gmake, MS_W32_H): + Update for new ms-w32.h location. + +2012-08-02 Paul Eggert + + Port to Solaris 8. + * syswait.h (WRETCODE): Remove, consistently with ../configure.ac. + +2012-08-02 Glenn Morris + + * nsterm.m (ns_exec_path, ns_load_path): Use SEPCHAR rather than + hard-coding the path separator. + +2012-08-01 Paul Eggert + + Use "ASET (a, i, v)" rather than "AREF (a, i) = v". + This how ASET and AREF are supposed to work, and makes + it easier to think about future improvements. See + . + * charset.h (set_charset_attr): New function. + All lvalue-style uses of CHARSET_DECODER etc. changed to use it. + * lisp.h (ASET): Rewrite so as not to use AREF in an lvalue style. + (aref_addr): New function. All uses of &AREF(...) changed. + (set_hash_key, set_hash_value, set_hash_next, set_hash_hash) + (set_hash_index): New functions. All lvalue-style uses of + HASH_KEY etc. changed. + * keyboard.c (set_prop): New function. All lvalue-style uses + of PROP changed. + +2012-08-01 Alp Aker + + * nsterm.m (ns_set_vertical_scroll_bar, ns_redeem_scroll_bar) + (EmacsWindow-accessibilityAttributeValue, EmacsScroller-initFrame:) + (EmacsScroller-dealloc): Adjust to use WVAR. (Bug#12114) + * nsfns.m (ns_set_name_as_filename): Likewise. + * nsmenu.m (ns_update_menubar): Likewise. + * nsselect.m (symbol_to_nsstring): Adjust to use SVAR. + +2012-08-01 Eli Zaretskii + + * .gdbinit (xcar, xcdr, xlist, xwindow, nextcons, xprintsym): + Adapt to latest changes in field names of the corresponding Lisp + objects. + + * xdisp.c (try_window_id): Use WVAR in IF_DEBUG code. + +2012-08-01 Glenn Morris + + * s/msdos.h: Remove file. + * conf_post.h [MSDOS]: New section, moved from s/msdos.h. + * Makefile.in (S_FILE): Remove. + (config_h): Remove S_FILE. + +2012-08-01 Juanma Barranquero + + * s/ms-w32.h (DEVICE_SEP, IS_DIRECTORY_SEP, IS_ANY_SEP): + Remove; moved to nt/config.nt. + 2012-08-01 Dmitry Antipov Use INTERNAL_FIELD for conses and overlays. @@ -91,7 +832,7 @@ Generalize INTERNAL_FIELD between buffers, keyboards and frames. * lisp.h (INTERNAL_FIELD): New macro. - * buffer.h (BUFFER_INTERNAL_FIELD): Removed. + * buffer.h (BUFFER_INTERNAL_FIELD): Remove. (BVAR): Change to use INTERNAL_FIELD. * keyboard.h (KBOARD_INTERNAL_FIELD): Likewise. (KVAR): Change to use INTERNAL_FIELD. @@ -146,8 +887,8 @@ * nsterm.m (ns_do_open_file): New variable. (ns_term_init): Set ns_do_open_file to YES after run returns. - (openFile, openTempFile, openFileWithoutUI, openFiles): Open - files only if ns_do_open_file. + (openFile, openTempFile, openFileWithoutUI, openFiles): + Open files only if ns_do_open_file. 2012-07-30 Paul Eggert @@ -284,7 +1025,7 @@ 2012-07-29 Eli Zaretskii - * w32heap.h (OS_9X): Renamed from OS_WINDOWS_95. + * w32heap.h (OS_9X): Rename from OS_WINDOWS_95. * w32heap.c (cache_system_info): * w32.c (sys_rename): @@ -301,8 +1042,8 @@ 2012-07-29 Dmitry Antipov Cleanup statistics calculation in Fgarbage_collect. - * alloc.c (Fgarbage_collect): Rename t1 to meaningful start. Fix - zombies percentage calculation. Simplify elapsed time calculation. + * alloc.c (Fgarbage_collect): Rename t1 to meaningful start. + Fix zombies percentage calculation. Simplify elapsed time calculation. 2012-07-29 Dmitry Antipov @@ -360,8 +1101,8 @@ Adjust GDB to reflect pvec_type changes (Bug#12036). * .gdbinit (xvectype, xpr, xbacktrace): Adjust to reflect the - 2012-07-04 changes to pseudovector representation. Problem - reported by Eli Zaretskii in . + 2012-07-04 changes to pseudovector representation. + Problem reported by Eli Zaretskii in . 2012-07-27 Michael Albinus @@ -622,8 +1363,8 @@ for the reasons. * w32menu.c (add_menu_item): Cast to ULONG_PTR when assigning - info.dwItemData. Fixes crashes on 64-bit Windows. Suggested by - Fabrice Popineau . + info.dwItemData. Fixes crashes on 64-bit Windows. + Suggested by Fabrice Popineau . 2012-07-21 Jan Djärv @@ -1249,8 +1990,8 @@ * lisp.h (intern, intern_c_string): Redefine as static inline wrappers for intern_1 and intern_c_string_1, respectively. (intern_1, intern_c_string_1): Rename prototypes. - * lread.c (intern_1, intern_c_string_1, oblookup): Simplify - Vobarray checking. + * lread.c (intern_1, intern_c_string_1, oblookup): + Simplify Vobarray checking. * font.c (font_intern_prop): Likewise. Adjust comment. * w32font.c (intern_font_name): Likewise. @@ -1319,8 +2060,8 @@ Avoid calls to strlen in font processing functions. * font.c (font_parse_name, font_parse_xlfd, font_parse_fcname) - (font_open_by_name): Change to use length argument. Adjust - users accordingly. + (font_open_by_name): Change to use length argument. + Adjust users accordingly. * font.h (font_open_by_name, font_parse_xlfd, font_unparse_xlfd): Adjust prototypes. * xfont.c (xfont_decode_coding_xlfd, font_unparse_xlfd): @@ -1452,8 +2193,8 @@ srclen argument and return the length of result. Adjust users accordingly. (directory_file_name): Fix comment. Change to add srclen argument, - swap 1st and 2nd arguments to obey the common convention. Adjust - users accordingly. + swap 1st and 2nd arguments to obey the common convention. + Adjust users accordingly. * filelock.c (fill_in_lock_file_name): Avoid calls to strlen. 2012-07-10 Glenn Morris @@ -1617,8 +2358,8 @@ Support truncation and continuation glyphs on GUI frames, when fringes are disabled. (Bug#11832) * xdisp.c (init_iterator): Get dimensions of truncation and - continuation glyphs even if on GUI frames. Adjust - it->last_visible_x on GUI frames when the left or right fringes, + continuation glyphs even if on GUI frames. + Adjust it->last_visible_x on GUI frames when the left or right fringes, or both, are absent. (start_display, move_it_in_display_line_to): Handle the case of a GUI frame without a fringe to display continuation or truncation @@ -2068,8 +2809,8 @@ Fix block vector allocation code to allow VECTOR_BLOCK_SIZE values which aren't power of 2. - * alloc.c (VECTOR_FREE_LIST_SIZE_MASK): New macro. Verify - it's value and the value of VECTOR_BLOCK_SIZE. Adjust users + * alloc.c (VECTOR_FREE_LIST_SIZE_MASK): New macro. + Verify it's value and the value of VECTOR_BLOCK_SIZE. Adjust users accordingly. 2012-07-03 Stefan Monnier @@ -2123,8 +2864,8 @@ * alloc.c (mark_buffer): Simplify. Remove prototype. (mark_object): Add comment. Reorganize marking of vector-like objects. Use CHECK_LIVE for all vector-like objects except buffers - and subroutines when GC_CHECK_MARKED_OBJECTS is defined. Avoid - redundant calls to mark_vectorlike for bool vectors. + and subroutines when GC_CHECK_MARKED_OBJECTS is defined. + Avoid redundant calls to mark_vectorlike for bool vectors. 2012-06-30 Glenn Morris @@ -9568,7 +10309,7 @@ * Makefile.in (SETTINGS_LIBS): Fix typo. -2011-07-01 Kazuhiro Ito (tiny patch) +2011-07-01 Kazuhiro Ito (tiny change) * coding.c (Fencode_coding_string): Record the last coding system used, as the function doc string says (bug#8738). diff --git a/src/Makefile.in b/src/Makefile.in index 1eb14c73f45..e4baeb5ffd6 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -56,9 +56,7 @@ lwlibdir = ../lwlib lispdir = ../lisp # Configuration files for .o files to depend on. -# MS-DOS sets S_FILE non-nil. -S_FILE = -config_h = config.h conf_post.h $(S_FILE) +config_h = config.h $(srcdir)/conf_post.h bootstrap_exe = $(abs_builddir)/bootstrap-emacs$(EXEEXT) diff --git a/src/alloc.c b/src/alloc.c index 2d5149a6772..1d484d4a322 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -19,6 +19,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ #include + +#define LISP_INLINE EXTERN_INLINE + #include #include /* For CHAR_BIT. */ #include @@ -152,7 +155,7 @@ static pthread_mutex_t alloc_mutex; /* Default value of gc_cons_threshold (see below). */ -#define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object)) +#define GC_DEFAULT_THRESHOLD (100000 * word_size) /* Global variables. */ struct emacs_globals globals; @@ -225,7 +228,7 @@ static ptrdiff_t pure_bytes_used_before_overflow; #define PURE_POINTER_P(P) \ ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size) -/* Index in pure at which next pure Lisp object will be allocated.. */ +/* Index in pure at which next pure Lisp object will be allocated.. */ static ptrdiff_t pure_bytes_used_lisp; @@ -251,6 +254,14 @@ static char *stack_copy; static ptrdiff_t stack_copy_size; #endif +static Lisp_Object Qconses; +static Lisp_Object Qsymbols; +static Lisp_Object Qmiscs; +static Lisp_Object Qstrings; +static Lisp_Object Qvectors; +static Lisp_Object Qfloats; +static Lisp_Object Qintervals; +static Lisp_Object Qbuffers; static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; static Lisp_Object Qgc_cons_threshold; Lisp_Object Qchar_table_extra_slots; @@ -275,14 +286,6 @@ static void sweep_strings (void); static void free_misc (Lisp_Object); extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; -/* Handy constants for vectorlike objects. */ -enum - { - header_size = offsetof (struct Lisp_Vector, contents), - bool_header_size = offsetof (struct Lisp_Bool_Vector, data), - word_size = sizeof (Lisp_Object) - }; - /* When scanning the C stack for live Lisp objects, Emacs keeps track of what memory allocated via lisp_malloc is intended for what purpose. This enumeration specifies the type of memory. */ @@ -526,7 +529,7 @@ buffer_memory_full (ptrdiff_t nbytes) #if USE_LSB_TAG # define XMALLOC_HEADER_ALIGNMENT \ - COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT) + COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT) #else # define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT #endif @@ -895,6 +898,16 @@ safe_alloca_unwind (Lisp_Object arg) return Qnil; } +/* Return a newly allocated memory block of SIZE bytes, remembering + to free it when unwinding. */ +void * +record_xmalloc (size_t size) +{ + void *p = xmalloc (size); + record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0)); + return p; +} + /* Like malloc but used for allocating Lisp data. NBYTES is the number of bytes to allocate, TYPE describes the intended use of the @@ -1537,36 +1550,14 @@ mark_interval (register INTERVAL i, Lisp_Object dummy) mark_object (i->plist); } - -/* Mark the interval tree rooted in TREE. Don't call this directly; - use the macro MARK_INTERVAL_TREE instead. */ - -static void -mark_interval_tree (register INTERVAL tree) -{ - /* No need to test if this tree has been marked already; this - function is always called through the MARK_INTERVAL_TREE macro, - which takes care of that. */ - - traverse_intervals_noorder (tree, mark_interval, Qnil); -} - - /* Mark the interval tree rooted in I. */ -#define MARK_INTERVAL_TREE(i) \ - do { \ - if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \ - mark_interval_tree (i); \ +#define MARK_INTERVAL_TREE(i) \ + do { \ + if (i && !i->gcmarkbit) \ + traverse_intervals_noorder (i, mark_interval, Qnil); \ } while (0) - -#define UNMARK_BALANCE_INTERVALS(i) \ - do { \ - if (! NULL_INTERVAL_P (i)) \ - (i) = balance_intervals (i); \ - } while (0) - /*********************************************************************** String Allocation ***********************************************************************/ @@ -2095,8 +2086,8 @@ sweep_strings (void) /* String is live; unmark it and its intervals. */ UNMARK_STRING (s); - if (!NULL_INTERVAL_P (s->intervals)) - UNMARK_BALANCE_INTERVALS (s->intervals); + /* Do not use string_(set|get)_intervals here. */ + s->intervals = balance_intervals (s->intervals); ++total_strings; total_string_bytes += STRING_BYTES (s); @@ -2497,7 +2488,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) return empty_multibyte_string; s = allocate_string (); - s->intervals = NULL_INTERVAL; + s->intervals = NULL; allocate_string_data (s, nchars, nbytes); XSETSTRING (string, s); string_chars_consed += nbytes; @@ -2686,7 +2677,7 @@ free_cons (struct Lisp_Cons *ptr) { ptr->u.chain = cons_free_list; #if GC_MARK_STACK - CVAR (ptr, car) = Vdead; + ptr->car = Vdead; #endif cons_free_list = ptr; consing_since_gc -= sizeof *ptr; @@ -2797,9 +2788,9 @@ listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...) Lisp_Object val, *objp; /* Change to SAFE_ALLOCA if you hit this eassert. */ - eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object)); + eassert (count <= MAX_ALLOCA / word_size); - objp = alloca (count * sizeof (Lisp_Object)); + objp = alloca (count * word_size); objp[0] = arg; va_start (ap, arg); for (i = 1; i < count; i++) @@ -2897,8 +2888,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, /* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */ enum { - roundup_size = COMMON_MULTIPLE (word_size, - USE_LSB_TAG ? 1 << GCTYPEBITS : 1) + roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1) }; /* ROUNDUP_SIZE must be a power of 2. */ @@ -3452,8 +3442,8 @@ union aligned_Lisp_Symbol { struct Lisp_Symbol s; #if USE_LSB_TAG - unsigned char c[(sizeof (struct Lisp_Symbol) + (1 << GCTYPEBITS) - 1) - & -(1 << GCTYPEBITS)]; + unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1) + & -GCALIGNMENT]; #endif }; @@ -3518,12 +3508,12 @@ Its value and function definition are void, and its property list is nil. */) MALLOC_UNBLOCK_INPUT; p = XSYMBOL (val); - SVAR (p, xname) = name; - SVAR (p, plist) = Qnil; + set_symbol_name (val, name); + set_symbol_plist (val, Qnil); p->redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (p, Qunbound); - SVAR (p, function) = Qunbound; - p->next = NULL; + set_symbol_function (val, Qunbound); + set_symbol_next (val, NULL); p->gcmarkbit = 0; p->interned = SYMBOL_UNINTERNED; p->constant = 0; @@ -3547,8 +3537,8 @@ union aligned_Lisp_Misc { union Lisp_Misc m; #if USE_LSB_TAG - unsigned char c[(sizeof (union Lisp_Misc) + (1 << GCTYPEBITS) - 1) - & -(1 << GCTYPEBITS)]; + unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1) + & -GCALIGNMENT]; #endif }; @@ -3650,7 +3640,7 @@ build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) overlay = allocate_misc (Lisp_Misc_Overlay); OVERLAY_START (overlay) = start; OVERLAY_END (overlay) = end; - OVERLAY_PLIST (overlay) = plist; + set_overlay_plist (overlay, plist); XOVERLAY (overlay)->next = NULL; return overlay; } @@ -4295,7 +4285,7 @@ live_cons_p (struct mem_node *m, void *p) && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) && (b != cons_block || offset / sizeof b->conses[0] < cons_block_index) - && !EQ (CVAR ((struct Lisp_Cons *) p, car), Vdead)); + && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); } else return 0; @@ -4321,7 +4311,7 @@ live_symbol_p (struct mem_node *m, void *p) && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]) && (b != symbol_block || offset / sizeof b->symbols[0] < symbol_block_index) - && !EQ (SVAR (((struct Lisp_Symbol *)p), function), Vdead)); + && !EQ (((struct Lisp_Symbol *)p)->function, Vdead)); } else return 0; @@ -4558,9 +4548,9 @@ mark_maybe_pointer (void *p) struct mem_node *m; /* Quickly rule out some values which can't point to Lisp data. - USE_LSB_TAG needs Lisp data to be aligned on multiples of 1 << GCTYPEBITS. + USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT. Otherwise, assume that Lisp data is aligned on even addresses. */ - if ((intptr_t) p % (USE_LSB_TAG ? 1 << GCTYPEBITS : 2)) + if ((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2)) return; m = mem_find (p); @@ -5075,7 +5065,7 @@ pure_alloc (size_t size, int type) { void *result; #if USE_LSB_TAG - size_t alignment = (1 << GCTYPEBITS); + size_t alignment = GCALIGNMENT; #else size_t alignment = alignof (EMACS_INT); @@ -5207,19 +5197,17 @@ make_pure_string (const char *data, ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte) { Lisp_Object string; - struct Lisp_String *s; - - s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); + struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); if (s->data == NULL) { - s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); + s->data = pure_alloc (nbytes + 1, -1); memcpy (s->data, data, nbytes); s->data[nbytes] = '\0'; } s->size = nchars; s->size_byte = multibyte ? nbytes : -1; - s->intervals = NULL_INTERVAL; + s->intervals = NULL; XSETSTRING (string, s); return string; } @@ -5231,13 +5219,11 @@ Lisp_Object make_pure_c_string (const char *data, ptrdiff_t nchars) { Lisp_Object string; - struct Lisp_String *s; - - s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); + struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); s->size = nchars; s->size_byte = -1; s->data = (unsigned char *) data; - s->intervals = NULL_INTERVAL; + s->intervals = NULL; XSETSTRING (string, s); return string; } @@ -5248,10 +5234,8 @@ make_pure_c_string (const char *data, ptrdiff_t nchars) Lisp_Object pure_cons (Lisp_Object car, Lisp_Object cdr) { - register Lisp_Object new; - struct Lisp_Cons *p; - - p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons); + Lisp_Object new; + struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); XSETCONS (new, p); XSETCAR (new, Fpurecopy (car)); XSETCDR (new, Fpurecopy (cdr)); @@ -5264,10 +5248,8 @@ pure_cons (Lisp_Object car, Lisp_Object cdr) static Lisp_Object make_pure_float (double num) { - register Lisp_Object new; - struct Lisp_Float *p; - - p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float); + Lisp_Object new; + struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); XSETFLOAT (new, p); XFLOAT_INIT (new, num); return new; @@ -5281,10 +5263,8 @@ static Lisp_Object make_pure_vector (ptrdiff_t len) { Lisp_Object new; - struct Lisp_Vector *p; size_t size = header_size + len * word_size; - - p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); + struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); XSETVECTOR (new, p); XVECTOR (new)->header.size = len; return new; @@ -5414,9 +5394,9 @@ See Info node `(elisp)Garbage Collection'. */) char stack_top_variable; ptrdiff_t i; int message_p; - Lisp_Object total[11]; ptrdiff_t count = SPECPDL_INDEX (); EMACS_TIME start; + Lisp_Object retval = Qnil; if (abort_on_gc) abort (); @@ -5635,59 +5615,62 @@ See Info node `(elisp)Garbage Collection'. */) } unbind_to (count, Qnil); + { + Lisp_Object total[11]; + int total_size = 10; - total[0] = list4 (Qcons, make_number (sizeof (struct Lisp_Cons)), - bounded_number (total_conses), - bounded_number (total_free_conses)); + total[0] = list4 (Qconses, make_number (sizeof (struct Lisp_Cons)), + bounded_number (total_conses), + bounded_number (total_free_conses)); - total[1] = list4 (Qsymbol, make_number (sizeof (struct Lisp_Symbol)), - bounded_number (total_symbols), - bounded_number (total_free_symbols)); + total[1] = list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)), + bounded_number (total_symbols), + bounded_number (total_free_symbols)); - total[2] = list4 (Qmisc, make_number (sizeof (union Lisp_Misc)), - bounded_number (total_markers), - bounded_number (total_free_markers)); + total[2] = list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)), + bounded_number (total_markers), + bounded_number (total_free_markers)); - total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)), - bounded_number (total_strings), - bounded_number (total_free_strings)); + total[3] = list4 (Qstrings, make_number (sizeof (struct Lisp_String)), + bounded_number (total_strings), + bounded_number (total_free_strings)); - total[4] = list3 (Qstring_bytes, make_number (1), - bounded_number (total_string_bytes)); + total[4] = list3 (Qstring_bytes, make_number (1), + bounded_number (total_string_bytes)); - total[5] = list3 (Qvector, make_number (sizeof (struct Lisp_Vector)), - bounded_number (total_vectors)); + total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)), + bounded_number (total_vectors)); - total[6] = list4 (Qvector_slots, make_number (word_size), - bounded_number (total_vector_slots), - bounded_number (total_free_vector_slots)); + total[6] = list4 (Qvector_slots, make_number (word_size), + bounded_number (total_vector_slots), + bounded_number (total_free_vector_slots)); - total[7] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)), - bounded_number (total_floats), - bounded_number (total_free_floats)); + total[7] = list4 (Qfloats, make_number (sizeof (struct Lisp_Float)), + bounded_number (total_floats), + bounded_number (total_free_floats)); - total[8] = list4 (Qinterval, make_number (sizeof (struct interval)), - bounded_number (total_intervals), - bounded_number (total_free_intervals)); + total[8] = list4 (Qintervals, make_number (sizeof (struct interval)), + bounded_number (total_intervals), + bounded_number (total_free_intervals)); - total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)), - bounded_number (total_buffers)); + total[9] = list3 (Qbuffers, make_number (sizeof (struct buffer)), + bounded_number (total_buffers)); - total[10] = list4 (Qheap, make_number (1024), #ifdef DOUG_LEA_MALLOC - bounded_number ((mallinfo ().uordblks + 1023) >> 10), - bounded_number ((mallinfo ().fordblks + 1023) >> 10) -#else - Qnil, Qnil + total_size++; + total[10] = list4 (Qheap, make_number (1024), + bounded_number ((mallinfo ().uordblks + 1023) >> 10), + bounded_number ((mallinfo ().fordblks + 1023) >> 10)); #endif - ); + retval = Flist (total_size, total); + } #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES { /* Compute average percentage of zombies. */ - double nlive = - (total_conses + total_symbols + total_markers + total_strings - + total_vectors + total_floats + total_intervals + total_buffers); + double nlive + = (total_conses + total_symbols + total_markers + total_strings + + total_vectors + total_floats + total_intervals + total_buffers); avg_live = (avg_live * ngcs + nlive) / (ngcs + 1); max_live = max (nlive, max_live); @@ -5714,7 +5697,7 @@ See Info node `(elisp)Garbage Collection'. */) gcs_done++; - return Flist (sizeof total / sizeof *total, total); + return retval; } @@ -5837,9 +5820,9 @@ mark_overlay (struct Lisp_Overlay *ptr) for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) { ptr->gcmarkbit = 1; - mark_object (MVAR (ptr, start)); - mark_object (MVAR (ptr, end)); - mark_object (MVAR (ptr, plist)); + mark_object (ptr->start); + mark_object (ptr->end); + mark_object (ptr->plist); } } @@ -5853,7 +5836,7 @@ mark_buffer (struct buffer *buffer) /* ...but there are some buffer-specific things. */ - MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); + MARK_INTERVAL_TREE (buffer_get_intervals (buffer)); /* For now, we just don't mark the undo_list. It's done later in a special way just before the sweep phase, and after stripping @@ -6020,7 +6003,7 @@ mark_object (Lisp_Object arg) /* Mark glyphs for leaf windows. Marking window matrices is sufficient because frame matrices use the same glyph memory. */ - if (NILP (WVAR (w, hchild)) && NILP (WVAR (w, vchild)) + if (NILP (w->hchild) && NILP (w->vchild) && w->current_matrix) { mark_glyph_matrix (w->current_matrix); @@ -6073,8 +6056,8 @@ mark_object (Lisp_Object arg) break; CHECK_ALLOCATED_AND_LIVE (live_symbol_p); ptr->gcmarkbit = 1; - mark_object (SVAR (ptr, function)); - mark_object (SVAR (ptr, plist)); + mark_object (ptr->function); + mark_object (ptr->plist); switch (ptr->redirect) { case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; @@ -6105,9 +6088,9 @@ mark_object (Lisp_Object arg) break; default: abort (); } - if (!PURE_POINTER_P (XSTRING (SVAR (ptr, xname)))) - MARK_STRING (XSTRING (SVAR (ptr, xname))); - MARK_INTERVAL_TREE (STRING_INTERVALS (SVAR (ptr, xname))); + if (!PURE_POINTER_P (XSTRING (ptr->name))) + MARK_STRING (XSTRING (ptr->name)); + MARK_INTERVAL_TREE (string_get_intervals (ptr->name)); ptr = ptr->next; if (ptr) @@ -6169,14 +6152,14 @@ mark_object (Lisp_Object arg) CHECK_ALLOCATED_AND_LIVE (live_cons_p); CONS_MARK (ptr); /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (CVAR (ptr, u.cdr), Qnil)) + if (EQ (ptr->u.cdr, Qnil)) { - obj = CVAR (ptr, car); + obj = ptr->car; cdr_count = 0; goto loop; } - mark_object (CVAR (ptr, car)); - obj = CVAR (ptr, u.cdr); + mark_object (ptr->car); + obj = ptr->u.cdr; cdr_count++; if (cdr_count == mark_object_loop_halt) abort (); @@ -6325,7 +6308,7 @@ gc_sweep (void) cblk->conses[pos].u.chain = cons_free_list; cons_free_list = &cblk->conses[pos]; #if GC_MARK_STACK - CVAR (cons_free_list, car) = Vdead; + cons_free_list->car = Vdead; #endif } else @@ -6422,7 +6405,7 @@ gc_sweep (void) { if (!iblk->intervals[i].gcmarkbit) { - SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list); + interval_set_parent (&iblk->intervals[i], interval_free_list); interval_free_list = &iblk->intervals[i]; this_free++; } @@ -6473,7 +6456,7 @@ gc_sweep (void) /* Check if the symbol was created during loadup. In such a case it might be pointed to by pure bytecode which we don't trace, so we conservatively assume that it is live. */ - int pure_p = PURE_POINTER_P (XSTRING (sym->s.INTERNAL_FIELD (xname))); + int pure_p = PURE_POINTER_P (XSTRING (sym->s.name)); if (!sym->s.gcmarkbit && !pure_p) { @@ -6482,7 +6465,7 @@ gc_sweep (void) sym->s.next = symbol_free_list; symbol_free_list = &sym->s; #if GC_MARK_STACK - SVAR (symbol_free_list, function) = Vdead; + symbol_free_list->function = Vdead; #endif ++this_free; } @@ -6490,7 +6473,7 @@ gc_sweep (void) { ++num_used; if (!pure_p) - UNMARK_STRING (XSTRING (sym->s.INTERNAL_FIELD (xname))); + UNMARK_STRING (XSTRING (sym->s.name)); sym->s.gcmarkbit = 0; } } @@ -6592,7 +6575,8 @@ gc_sweep (void) else { VECTOR_UNMARK (buffer); - UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); + /* Do not use buffer_(set|get)_intervals here. */ + buffer->text->intervals = balance_intervals (buffer->text->intervals); total_buffers++; prev = buffer, buffer = buffer->header.next.buffer; } @@ -6675,10 +6659,10 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) XSETSYMBOL (tem, sym); val = find_symbol_value (tem); if (EQ (val, obj) - || EQ (SVAR (sym, function), obj) - || (!NILP (SVAR (sym, function)) - && COMPILEDP (SVAR (sym, function)) - && EQ (AREF (SVAR (sym, function), COMPILED_BYTECODE), obj)) + || EQ (sym->function, obj) + || (!NILP (sym->function) + && COMPILEDP (sym->function) + && EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) || (!NILP (val) && COMPILEDP (val) && EQ (AREF (val, COMPILED_BYTECODE), obj))) @@ -6831,6 +6815,14 @@ do hash-consing of the objects allocated to pure space. */); doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); Vmemory_full = Qnil; + DEFSYM (Qconses, "conses"); + DEFSYM (Qsymbols, "symbols"); + DEFSYM (Qmiscs, "miscs"); + DEFSYM (Qstrings, "strings"); + DEFSYM (Qvectors, "vectors"); + DEFSYM (Qfloats, "floats"); + DEFSYM (Qintervals, "intervals"); + DEFSYM (Qbuffers, "buffers"); DEFSYM (Qstring_bytes, "string-bytes"); DEFSYM (Qvector_slots, "vector-slots"); DEFSYM (Qheap, "heap"); diff --git a/src/buffer.c b/src/buffer.c index 8b7f524e27a..56d6231f5f8 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -19,6 +19,8 @@ along with GNU Emacs. If not, see . */ #include +#define BUFFER_INLINE EXTERN_INLINE + #include #include #include @@ -97,7 +99,7 @@ static Lisp_Object Vbuffer_local_symbols; /* Maximum length of an overlay vector. */ #define OVERLAY_COUNT_MAX \ ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, \ - min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object))) + min (PTRDIFF_MAX, SIZE_MAX) / word_size)) /* Flags indicating which built-in buffer-local variables are permanent locals. */ @@ -191,9 +193,9 @@ followed by the rest of the buffers. */) Lisp_Object args[3]; CHECK_FRAME (frame); - framelist = Fcopy_sequence (FVAR (XFRAME (frame), buffer_list)); + framelist = Fcopy_sequence (XFRAME (frame)->buffer_list); prevlist = Fnreverse (Fcopy_sequence - (FVAR (XFRAME (frame), buried_buffer_list))); + (XFRAME (frame)->buried_buffer_list)); /* Remove from GENERAL any buffer that duplicates one in FRAMELIST or PREVLIST. */ @@ -358,7 +360,7 @@ even if it is dead. The return value is never nil. */) BUF_CHARS_MODIFF (b) = 1; BUF_OVERLAY_MODIFF (b) = 1; BUF_SAVE_MODIFF (b) = 1; - BUF_INTERVALS (b) = 0; + buffer_set_intervals (b, NULL); BUF_UNCHANGED_MODIFIED (b) = 1; BUF_OVERLAY_UNCHANGED_MODIFIED (b) = 1; BUF_END_UNCHANGED (b) = 0; @@ -368,7 +370,7 @@ even if it is dead. The return value is never nil. */) b->newline_cache = 0; b->width_run_cache = 0; - BVAR (b, width_table) = Qnil; + BSET (b, width_table, Qnil); b->prevent_redisplay_optimizations_p = 1; /* Put this on the chain of all buffers including killed ones. */ @@ -377,20 +379,20 @@ even if it is dead. The return value is never nil. */) /* An ordinary buffer normally doesn't need markers to handle BEGV and ZV. */ - BVAR (b, pt_marker) = Qnil; - BVAR (b, begv_marker) = Qnil; - BVAR (b, zv_marker) = Qnil; + BSET (b, pt_marker, Qnil); + BSET (b, begv_marker, Qnil); + BSET (b, zv_marker, Qnil); name = Fcopy_sequence (buffer_or_name); - STRING_SET_INTERVALS (name, NULL_INTERVAL); - BVAR (b, name) = name; + string_set_intervals (name, NULL); + BSET (b, name, name); - BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; + BSET (b, undo_list, (SREF (name, 0) != ' ') ? Qnil : Qt); reset_buffer (b); reset_buffer_local_variables (b, 1); - BVAR (b, mark) = Fmake_marker (); + BSET (b, mark, Fmake_marker ()); BUF_MARKERS (b) = NULL; /* Put this in the alist of all live buffers. */ @@ -417,17 +419,17 @@ copy_overlays (struct buffer *b, struct Lisp_Overlay *list) Lisp_Object overlay, start, end; struct Lisp_Marker *m; - eassert (MARKERP (MVAR (list, start))); - m = XMARKER (MVAR (list, start)); + eassert (MARKERP (list->start)); + m = XMARKER (list->start); start = build_marker (b, m->charpos, m->bytepos); XMARKER (start)->insertion_type = m->insertion_type; - eassert (MARKERP (MVAR (list, end))); - m = XMARKER (MVAR (list, end)); + eassert (MARKERP (list->end)); + m = XMARKER (list->end); end = build_marker (b, m->charpos, m->bytepos); XMARKER (end)->insertion_type = m->insertion_type; - overlay = build_overlay (start, end, Fcopy_sequence (MVAR (list, plist))); + overlay = build_overlay (start, end, Fcopy_sequence (list->plist)); if (tail) tail = tail->next = XOVERLAY (overlay); else @@ -472,12 +474,12 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) memcpy (to->local_flags, from->local_flags, sizeof to->local_flags); - to->overlays_before = copy_overlays (to, from->overlays_before); - to->overlays_after = copy_overlays (to, from->overlays_after); + buffer_set_overlays_before (to, copy_overlays (to, from->overlays_before)); + buffer_set_overlays_after (to, copy_overlays (to, from->overlays_after)); /* Get (a copy of) the alist of Lisp-level local variables of FROM and install that in TO. */ - BVAR (to, local_var_alist) = buffer_lisp_local_variables (from, 1); + BSET (to, local_var_alist, buffer_lisp_local_variables (from, 1)); } @@ -580,15 +582,15 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b->newline_cache = 0; b->width_run_cache = 0; - BVAR (b, width_table) = Qnil; + BSET (b, width_table, Qnil); /* Put this on the chain of all buffers including killed ones. */ b->header.next.buffer = all_buffers; all_buffers = b; name = Fcopy_sequence (name); - STRING_SET_INTERVALS (name, NULL_INTERVAL); - BVAR (b, name) = name; + string_set_intervals (name, NULL); + BSET (b, name, name); reset_buffer (b); reset_buffer_local_variables (b, 1); @@ -597,10 +599,10 @@ CLONE nil means the indirect buffer's state is reset to default values. */) XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); - BVAR (b, mark) = Fmake_marker (); + BSET (b, mark, Fmake_marker ()); /* The multibyte status belongs to the base buffer. */ - BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters); + BSET (b, enable_multibyte_characters, BVAR (b->base_buffer, enable_multibyte_characters)); /* Make sure the base buffer has markers for its narrowing. */ if (NILP (BVAR (b->base_buffer, pt_marker))) @@ -608,14 +610,14 @@ CLONE nil means the indirect buffer's state is reset to default values. */) eassert (NILP (BVAR (b->base_buffer, begv_marker))); eassert (NILP (BVAR (b->base_buffer, zv_marker))); - BVAR (b->base_buffer, pt_marker) - = build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte); + BSET (b->base_buffer, pt_marker, + build_marker (b->base_buffer, b->base_buffer->pt, b->base_buffer->pt_byte)); - BVAR (b->base_buffer, begv_marker) - = build_marker (b->base_buffer, b->base_buffer->begv, b->base_buffer->begv_byte); + BSET (b->base_buffer, begv_marker, + build_marker (b->base_buffer, b->base_buffer->begv, b->base_buffer->begv_byte)); - BVAR (b->base_buffer, zv_marker) - = build_marker (b->base_buffer, b->base_buffer->zv, b->base_buffer->zv_byte); + BSET (b->base_buffer, zv_marker, + build_marker (b->base_buffer, b->base_buffer->zv, b->base_buffer->zv_byte)); XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1; } @@ -623,9 +625,9 @@ CLONE nil means the indirect buffer's state is reset to default values. */) if (NILP (clone)) { /* Give the indirect buffer markers for its narrowing. */ - BVAR (b, pt_marker) = build_marker (b, b->pt, b->pt_byte); - BVAR (b, begv_marker) = build_marker (b, b->begv, b->begv_byte); - BVAR (b, zv_marker) = build_marker (b, b->zv, b->zv_byte); + BSET (b, pt_marker, build_marker (b, b->pt, b->pt_byte)); + BSET (b, begv_marker, build_marker (b, b->begv, b->begv_byte)); + BSET (b, zv_marker, build_marker (b, b->zv, b->zv_byte)); XMARKER (BVAR (b, zv_marker))->insertion_type = 1; } else @@ -633,11 +635,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */) struct buffer *old_b = current_buffer; clone_per_buffer_values (b->base_buffer, b); - BVAR (b, filename) = Qnil; - BVAR (b, file_truename) = Qnil; - BVAR (b, display_count) = make_number (0); - BVAR (b, backed_up) = Qnil; - BVAR (b, auto_save_file_name) = Qnil; + BSET (b, filename, Qnil); + BSET (b, file_truename, Qnil); + BSET (b, display_count, make_number (0)); + BSET (b, backed_up, Qnil); + BSET (b, auto_save_file_name, Qnil); set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); @@ -657,11 +659,11 @@ CLONE nil means the indirect buffer's state is reset to default values. */) static void drop_overlay (struct buffer *b, struct Lisp_Overlay *ov) { - eassert (b == XBUFFER (Fmarker_buffer (MVAR (ov, start)))); - modify_overlay (b, marker_position (MVAR (ov, start)), - marker_position (MVAR (ov, end))); - Fset_marker (MVAR (ov, start), Qnil, Qnil); - Fset_marker (MVAR (ov, end), Qnil, Qnil); + eassert (b == XBUFFER (Fmarker_buffer (ov->start))); + modify_overlay (b, marker_position (ov->start), + marker_position (ov->end)); + Fset_marker (ov->start, Qnil, Qnil); + Fset_marker (ov->end, Qnil, Qnil); } @@ -686,7 +688,8 @@ delete_all_overlays (struct buffer *b) ov->next = NULL; } - b->overlays_before = b->overlays_after = NULL; + buffer_set_overlays_before (b, NULL); + buffer_set_overlays_after (b, NULL); } /* Reinitialize everything about a buffer except its name and contents @@ -699,9 +702,10 @@ delete_all_overlays (struct buffer *b) void reset_buffer (register struct buffer *b) { - BVAR (b, filename) = Qnil; - BVAR (b, file_truename) = Qnil; - BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; + BSET (b, filename, Qnil); + BSET (b, file_truename, Qnil); + BSET (b, directory, + (current_buffer) ? BVAR (current_buffer, directory) : Qnil); b->modtime = make_emacs_time (0, UNKNOWN_MODTIME_NSECS); b->modtime_size = -1; XSETFASTINT (BVAR (b, save_length), 0); @@ -709,24 +713,25 @@ reset_buffer (register struct buffer *b) /* It is more conservative to start out "changed" than "unchanged". */ b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; - BVAR (b, backed_up) = Qnil; + BSET (b, backed_up, Qnil); BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = 0; - BVAR (b, auto_save_file_name) = Qnil; - BVAR (b, read_only) = Qnil; - b->overlays_before = NULL; - b->overlays_after = NULL; + BSET (b, auto_save_file_name, Qnil); + BSET (b, read_only, Qnil); + buffer_set_overlays_before (b, NULL); + buffer_set_overlays_after (b, NULL); b->overlay_center = BEG; - BVAR (b, mark_active) = Qnil; - BVAR (b, point_before_scroll) = Qnil; - BVAR (b, file_format) = Qnil; - BVAR (b, auto_save_file_format) = Qt; - BVAR (b, last_selected_window) = Qnil; - XSETINT (BVAR (b, display_count), 0); - BVAR (b, display_time) = Qnil; - BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters); - BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type); - BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing); + BSET (b, mark_active, Qnil); + BSET (b, point_before_scroll, Qnil); + BSET (b, file_format, Qnil); + BSET (b, auto_save_file_format, Qt); + BSET (b, last_selected_window, Qnil); + BSET (b, display_count, make_number (0)); + BSET (b, display_time, Qnil); + BSET (b, enable_multibyte_characters, + BVAR (&buffer_defaults, enable_multibyte_characters)); + BSET (b, cursor_type, BVAR (&buffer_defaults, cursor_type)); + BSET (b, extra_line_spacing, BVAR (&buffer_defaults, extra_line_spacing)); b->display_error_modiff = 0; } @@ -750,10 +755,10 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) things that depend on the major mode. default-major-mode is handled at a higher level. We ignore it here. */ - BVAR (b, major_mode) = Qfundamental_mode; - BVAR (b, keymap) = Qnil; - BVAR (b, mode_name) = QSFundamental; - BVAR (b, minor_modes) = Qnil; + BSET (b, major_mode, Qfundamental_mode); + BSET (b, keymap, Qnil); + BSET (b, mode_name, QSFundamental); + BSET (b, minor_modes, Qnil); /* If the standard case table has been altered and invalidated, fix up its insides first. */ @@ -762,15 +767,15 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) Fset_standard_case_table (Vascii_downcase_table); - BVAR (b, downcase_table) = Vascii_downcase_table; - BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; - BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; - BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; - BVAR (b, invisibility_spec) = Qt; + BSET (b, downcase_table, Vascii_downcase_table); + BSET (b, upcase_table, XCHAR_TABLE (Vascii_downcase_table)->extras[0]); + BSET (b, case_canon_table, XCHAR_TABLE (Vascii_downcase_table)->extras[1]); + BSET (b, case_eqv_table, XCHAR_TABLE (Vascii_downcase_table)->extras[2]); + BSET (b, invisibility_spec, Qt); /* Reset all (or most) per-buffer variables to their defaults. */ if (permanent_too) - BVAR (b, local_var_alist) = Qnil; + BSET (b, local_var_alist, Qnil); else { Lisp_Object tmp, prop, last = Qnil; @@ -804,7 +809,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) } /* Delete this local variable. */ else if (NILP (last)) - BVAR (b, local_var_alist) = XCDR (tmp); + BSET (b, local_var_alist, XCDR (tmp)); else XSETCDR (last, XCDR (tmp)); } @@ -1281,7 +1286,7 @@ This does not change the name of the visited file (if any). */) error ("Buffer name `%s' is in use", SDATA (newname)); } - BVAR (current_buffer, name) = newname; + BSET (current_buffer, name, newname); /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ @@ -1325,7 +1330,7 @@ exists, return the buffer `*scratch*' (creating it if necessary). */) pred = frame_buffer_predicate (frame); /* Consider buffers that have been seen in the frame first. */ - tail = FVAR (XFRAME (frame), buffer_list); + tail = XFRAME (frame)->buffer_list; for (; CONSP (tail); tail = XCDR (tail)) { buf = XCAR (tail); @@ -1426,7 +1431,7 @@ No argument or nil as argument means do this for the current buffer. */) } if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt)) - BVAR (XBUFFER (real_buffer), undo_list) = Qnil; + BSET (XBUFFER (real_buffer), undo_list, Qnil); return Qnil; } @@ -1558,7 +1563,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) since anything can happen within do_yes_or_no_p. */ /* Don't kill the minibuffer now current. */ - if (EQ (buffer, WVAR (XWINDOW (minibuf_window), buffer))) + if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; /* When we kill an ordinary buffer which shares it's buffer text @@ -1609,7 +1614,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) /* If the buffer now current is shown in the minibuffer and our buffer is the sole other buffer give up. */ XSETBUFFER (tem, current_buffer); - if (EQ (tem, WVAR (XWINDOW (minibuf_window), buffer)) + if (EQ (tem, XWINDOW (minibuf_window)->buffer) && EQ (buffer, Fother_buffer (buffer, Qnil, Qnil))) return Qnil; @@ -1686,7 +1691,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) m = next; } BUF_MARKERS (b) = NULL; - BUF_INTERVALS (b) = NULL_INTERVAL; + buffer_set_intervals (b, NULL); /* Perhaps we should explicitly free the interval tree here... */ } @@ -1698,7 +1703,7 @@ cleaning up all windows currently displaying the buffer to be killed. */) swap_out_buffer_local_variables (b); reset_buffer_local_variables (b, 1); - BVAR (b, name) = Qnil; + BSET (b, name, Qnil); BLOCK_INPUT; if (b->base_buffer) @@ -1722,9 +1727,9 @@ cleaning up all windows currently displaying the buffer to be killed. */) free_region_cache (b->width_run_cache); b->width_run_cache = 0; } - BVAR (b, width_table) = Qnil; + BSET (b, width_table, Qnil); UNBLOCK_INPUT; - BVAR (b, undo_list) = Qnil; + BSET (b, undo_list, Qnil); /* Run buffer-list-update-hook. */ if (!NILP (Vrun_hooks)) @@ -1765,8 +1770,8 @@ record_buffer (Lisp_Object buffer) Vinhibit_quit = tem; /* Update buffer list of selected frame. */ - FVAR (f, buffer_list) = Fcons (buffer, Fdelq (buffer, FVAR (f, buffer_list))); - FVAR (f, buried_buffer_list) = Fdelq (buffer, FVAR (f, buried_buffer_list)); + FSET (f, buffer_list, Fcons (buffer, Fdelq (buffer, f->buffer_list))); + FSET (f, buried_buffer_list, Fdelq (buffer, f->buried_buffer_list)); /* Run buffer-list-update-hook. */ if (!NILP (Vrun_hooks)) @@ -1803,9 +1808,9 @@ DEFUN ("bury-buffer-internal", Fbury_buffer_internal, Sbury_buffer_internal, Vinhibit_quit = tem; /* Update buffer lists of selected frame. */ - FVAR (f, buffer_list) = Fdelq (buffer, FVAR (f, buffer_list)); - FVAR (f, buried_buffer_list) - = Fcons (buffer, Fdelq (buffer, FVAR (f, buried_buffer_list))); + FSET (f, buffer_list, Fdelq (buffer, f->buffer_list)); + FSET (f, buried_buffer_list, + Fcons (buffer, Fdelq (buffer, f->buried_buffer_list))); /* Run buffer-list-update-hook. */ if (!NILP (Vrun_hooks)) @@ -1905,7 +1910,7 @@ set_buffer_internal_1 (register struct buffer *b) /* Put the undo list back in the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (old_buf->base_buffer) - BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list); + BSET (old_buf->base_buffer, undo_list, BVAR (old_buf, undo_list)); /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ @@ -1915,7 +1920,7 @@ set_buffer_internal_1 (register struct buffer *b) /* Get the undo list from the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (b->base_buffer) - BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list); + BSET (b, undo_list, BVAR (b->base_buffer, undo_list)); /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ @@ -2113,8 +2118,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, #define swapfield_(field, type) \ do { \ type tmp##field = BVAR (other_buffer, field); \ - BVAR (other_buffer, field) = BVAR (current_buffer, field); \ - BVAR (current_buffer, field) = tmp##field; \ + BSET (other_buffer, field, BVAR (current_buffer, field)); \ + BSET (current_buffer, field, tmp##field); \ } while (0) swapfield (own_text, struct buffer_text); @@ -2154,8 +2159,8 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, swapfield_ (pt_marker, Lisp_Object); swapfield_ (begv_marker, Lisp_Object); swapfield_ (zv_marker, Lisp_Object); - BVAR (current_buffer, point_before_scroll) = Qnil; - BVAR (other_buffer, point_before_scroll) = Qnil; + BSET (current_buffer, point_before_scroll, Qnil); + BSET (other_buffer, point_before_scroll, Qnil); current_buffer->text->modiff++; other_buffer->text->modiff++; current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; @@ -2191,13 +2196,13 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, while (NILP (Fmemq (w, ws))) { ws = Fcons (w, ws); - if (MARKERP (WVAR (XWINDOW (w), pointm)) - && (EQ (WVAR (XWINDOW (w), buffer), buf1) - || EQ (WVAR (XWINDOW (w), buffer), buf2))) - Fset_marker (WVAR (XWINDOW (w), pointm), + if (MARKERP (XWINDOW (w)->pointm) + && (EQ (XWINDOW (w)->buffer, buf1) + || EQ (XWINDOW (w)->buffer, buf2))) + Fset_marker (XWINDOW (w)->pointm, make_number - (BUF_BEGV (XBUFFER (WVAR (XWINDOW (w), buffer)))), - WVAR (XWINDOW (w), buffer)); + (BUF_BEGV (XBUFFER (XWINDOW (w)->buffer))), + XWINDOW (w)->buffer); w = Fnext_window (w, Qt, Qt); } } @@ -2244,7 +2249,7 @@ current buffer is cleared. */) /* Don't record these buffer changes. We will put a special undo entry instead. */ - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, undo_list, Qt); /* If the cached position is for this buffer, clear it out. */ clear_charpos_cache (current_buffer); @@ -2266,7 +2271,7 @@ current buffer is cleared. */) to calculate the old correspondences. */ set_intervals_multibyte (0); - BVAR (current_buffer, enable_multibyte_characters) = Qnil; + BSET (current_buffer, enable_multibyte_characters, Qnil); Z = Z_BYTE; BEGV = BEGV_BYTE; @@ -2404,7 +2409,7 @@ current buffer is cleared. */) /* Do this first, so that chars_in_text asks the right question. set_intervals_multibyte needs it too. */ - BVAR (current_buffer, enable_multibyte_characters) = Qt; + BSET (current_buffer, enable_multibyte_characters, Qt); GPT_BYTE = advance_to_char_boundary (GPT_BYTE); GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; @@ -2462,10 +2467,11 @@ current buffer is cleared. */) if (!EQ (old_undo, Qt)) { /* Represent all the above changes by a special undo entry. */ - BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply, - intern ("set-buffer-multibyte"), - NILP (flag) ? Qt : Qnil), - old_undo); + BSET (current_buffer, undo_list, + Fcons (list3 (Qapply, + intern ("set-buffer-multibyte"), + NILP (flag) ? Qt : Qnil), + old_undo)); } UNGCPRO; @@ -3232,7 +3238,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) if (prev) prev->next = next; else - buf->overlays_before = next; + buffer_set_overlays_before (buf, next); /* Search thru overlays_after for where to put it. */ other_prev = NULL; @@ -3254,7 +3260,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) if (other_prev) other_prev->next = tail; else - buf->overlays_after = tail; + buffer_set_overlays_after (buf, tail); tail = prev; } else @@ -3290,7 +3296,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) if (prev) prev->next = next; else - buf->overlays_after = next; + buffer_set_overlays_after (buf, next); /* Search thru overlays_before for where to put it. */ other_prev = NULL; @@ -3312,7 +3318,7 @@ recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos) if (other_prev) other_prev->next = tail; else - buf->overlays_before = tail; + buffer_set_overlays_before (buf, tail); tail = prev; } } @@ -3417,7 +3423,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) beforep = tail; } if (!parent) - current_buffer->overlays_before = tail->next; + buffer_set_overlays_before (current_buffer, tail->next); else parent->next = tail->next; tail = tail->next; @@ -3463,7 +3469,7 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) beforep = tail; } if (!parent) - current_buffer->overlays_after = tail->next; + buffer_set_overlays_after (current_buffer, tail->next); else parent->next = tail->next; tail = tail->next; @@ -3477,14 +3483,14 @@ fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) if (beforep) { beforep->next = current_buffer->overlays_before; - current_buffer->overlays_before = before_list; + buffer_set_overlays_before (current_buffer, before_list); } recenter_overlay_lists (current_buffer, current_buffer->overlay_center); if (afterp) { afterp->next = current_buffer->overlays_after; - current_buffer->overlays_after = after_list; + buffer_set_overlays_after (current_buffer, after_list); } recenter_overlay_lists (current_buffer, current_buffer->overlay_center); } @@ -3561,7 +3567,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) if (!right_pair) { found->next = bp->overlays_before; - bp->overlays_before = found; + buffer_set_overlays_before (bp, found); } else { @@ -3639,13 +3645,13 @@ for the rear of the overlay advance when text is inserted there { if (b->overlays_after) XOVERLAY (overlay)->next = b->overlays_after; - b->overlays_after = XOVERLAY (overlay); + buffer_set_overlays_after (b, XOVERLAY (overlay)); } else { if (b->overlays_before) XOVERLAY (overlay)->next = b->overlays_before; - b->overlays_before = XOVERLAY (overlay); + buffer_set_overlays_before (b, XOVERLAY (overlay)); } /* This puts it in the right list, and in the right order. */ @@ -3673,7 +3679,7 @@ modify_overlay (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) /* If this is a buffer not in the selected window, we must do other windows. */ - if (buf != XBUFFER (WVAR (XWINDOW (selected_window), buffer))) + if (buf != XBUFFER (XWINDOW (selected_window)->buffer)) windows_or_buffers_changed = 1; /* If multiple windows show this buffer, we must do other windows. */ else if (buffer_shared > 1) @@ -3703,6 +3709,18 @@ unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay) return list; } +/* Remove OVERLAY from both overlay lists of B. */ + +static void +unchain_both (struct buffer *b, Lisp_Object overlay) +{ + struct Lisp_Overlay *ov = XOVERLAY (overlay); + + buffer_set_overlays_before (b, unchain_overlay (b->overlays_before, ov)); + buffer_set_overlays_after (b, unchain_overlay (b->overlays_after, ov)); + eassert (XOVERLAY (overlay)->next == NULL); +} + DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0, doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER. If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now. @@ -3753,11 +3771,7 @@ buffer. */) o_beg = OVERLAY_POSITION (OVERLAY_START (overlay)); o_end = OVERLAY_POSITION (OVERLAY_END (overlay)); - ob->overlays_before = - unchain_overlay (ob->overlays_before, XOVERLAY (overlay)); - ob->overlays_after = - unchain_overlay (ob->overlays_after, XOVERLAY (overlay)); - eassert (XOVERLAY (overlay)->next == NULL); + unchain_both (ob, overlay); } /* Set the overlay boundaries, which may clip them. */ @@ -3798,12 +3812,12 @@ buffer. */) if (n_end < b->overlay_center) { XOVERLAY (overlay)->next = b->overlays_after; - b->overlays_after = XOVERLAY (overlay); + buffer_set_overlays_after (b, XOVERLAY (overlay)); } else { XOVERLAY (overlay)->next = b->overlays_before; - b->overlays_before = XOVERLAY (overlay); + buffer_set_overlays_before (b, XOVERLAY (overlay)); } /* This puts it in the right list, and in the right order. */ @@ -3829,12 +3843,7 @@ DEFUN ("delete-overlay", Fdelete_overlay, Sdelete_overlay, 1, 1, 0, b = XBUFFER (buffer); specbind (Qinhibit_quit, Qt); - b->overlays_before - = unchain_overlay (b->overlays_before, XOVERLAY (overlay)); - b->overlays_after - = unchain_overlay (b->overlays_after, XOVERLAY (overlay)); - eassert (XOVERLAY (overlay)->next == NULL); - + unchain_both (b, overlay); drop_overlay (b, XOVERLAY (overlay)); /* When deleting an overlay with before or after strings, turn off @@ -3887,7 +3896,7 @@ OVERLAY. */) { CHECK_OVERLAY (overlay); - return Fcopy_sequence (MVAR (XOVERLAY (overlay), plist)); + return Fcopy_sequence (XOVERLAY (overlay)->plist); } @@ -4031,6 +4040,7 @@ However, the overlays you get are the real objects that the buffer uses. */) { struct Lisp_Overlay *ol; Lisp_Object before = Qnil, after = Qnil, tmp; + for (ol = current_buffer->overlays_before; ol; ol = ol->next) { XSETMISC (tmp, ol); @@ -4041,6 +4051,7 @@ However, the overlays you get are the real objects that the buffer uses. */) XSETMISC (tmp, ol); after = Fcons (tmp, after); } + return Fcons (Fnreverse (before), Fnreverse (after)); } @@ -4063,7 +4074,7 @@ DEFUN ("overlay-get", Foverlay_get, Soverlay_get, 2, 2, 0, (Lisp_Object overlay, Lisp_Object prop) { CHECK_OVERLAY (overlay); - return lookup_char_property (MVAR (XOVERLAY (overlay), plist), prop, 0); + return lookup_char_property (XOVERLAY (overlay)->plist, prop, 0); } DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3, 0, @@ -4078,7 +4089,7 @@ VALUE will be returned.*/) buffer = Fmarker_buffer (OVERLAY_START (overlay)); - for (tail = MVAR (XOVERLAY (overlay), plist); + for (tail = XOVERLAY (overlay)->plist; CONSP (tail) && CONSP (XCDR (tail)); tail = XCDR (XCDR (tail))) if (EQ (XCAR (tail), prop)) @@ -4089,8 +4100,8 @@ VALUE will be returned.*/) } /* It wasn't in the list, so add it to the front. */ changed = !NILP (value); - MVAR (XOVERLAY (overlay), plist) - = Fcons (prop, Fcons (value, MVAR (XOVERLAY (overlay), plist))); + set_overlay_plist + (overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist))); found: if (! NILP (buffer)) { @@ -4265,7 +4276,7 @@ report_overlay_modification (Lisp_Object start, Lisp_Object end, int after, ptrdiff_t i; memcpy (copy, XVECTOR (last_overlay_modification_hooks)->contents, - size * sizeof (Lisp_Object)); + size * word_size); gcpro1.var = copy; gcpro1.nvars = size; @@ -4884,8 +4895,7 @@ init_buffer_once (void) sure that this is still correct. Otherwise, mark_vectorlike may not trace all Lisp_Objects in buffer_defaults and buffer_local_symbols. */ const int pvecsize - = (offsetof (struct buffer, own_text) - sizeof (struct vectorlike_header)) - / sizeof (Lisp_Object); + = (offsetof (struct buffer, own_text) - header_size) / word_size; memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags); @@ -4903,8 +4913,8 @@ init_buffer_once (void) /* No one will share the text with these buffers, but let's play it safe. */ buffer_defaults.indirections = 0; buffer_local_symbols.indirections = 0; - BUF_INTERVALS (&buffer_defaults) = 0; - BUF_INTERVALS (&buffer_local_symbols) = 0; + buffer_set_intervals (&buffer_defaults, NULL); + buffer_set_intervals (&buffer_local_symbols, NULL); XSETPVECTYPESIZE (&buffer_defaults, PVEC_BUFFER, pvecsize); XSETBUFFER (Vbuffer_defaults, &buffer_defaults); XSETPVECTYPESIZE (&buffer_local_symbols, PVEC_BUFFER, pvecsize); @@ -4914,55 +4924,55 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - BVAR (&buffer_defaults, mode_line_format) = build_pure_c_string ("%-"); - BVAR (&buffer_defaults, header_line_format) = Qnil; - BVAR (&buffer_defaults, abbrev_mode) = Qnil; - BVAR (&buffer_defaults, overwrite_mode) = Qnil; - BVAR (&buffer_defaults, case_fold_search) = Qt; - BVAR (&buffer_defaults, auto_fill_function) = Qnil; - BVAR (&buffer_defaults, selective_display) = Qnil; - BVAR (&buffer_defaults, selective_display_ellipses) = Qt; - BVAR (&buffer_defaults, abbrev_table) = Qnil; - BVAR (&buffer_defaults, display_table) = Qnil; - BVAR (&buffer_defaults, undo_list) = Qnil; - BVAR (&buffer_defaults, mark_active) = Qnil; - BVAR (&buffer_defaults, file_format) = Qnil; - BVAR (&buffer_defaults, auto_save_file_format) = Qt; - buffer_defaults.overlays_before = NULL; - buffer_defaults.overlays_after = NULL; + BSET (&buffer_defaults, mode_line_format, build_pure_c_string ("%-")); + BSET (&buffer_defaults, header_line_format, Qnil); + BSET (&buffer_defaults, abbrev_mode, Qnil); + BSET (&buffer_defaults, overwrite_mode, Qnil); + BSET (&buffer_defaults, case_fold_search, Qt); + BSET (&buffer_defaults, auto_fill_function, Qnil); + BSET (&buffer_defaults, selective_display, Qnil); + BSET (&buffer_defaults, selective_display_ellipses, Qt); + BSET (&buffer_defaults, abbrev_table, Qnil); + BSET (&buffer_defaults, display_table, Qnil); + BSET (&buffer_defaults, undo_list, Qnil); + BSET (&buffer_defaults, mark_active, Qnil); + BSET (&buffer_defaults, file_format, Qnil); + BSET (&buffer_defaults, auto_save_file_format, Qt); + buffer_set_overlays_before (&buffer_defaults, NULL); + buffer_set_overlays_after (&buffer_defaults, NULL); buffer_defaults.overlay_center = BEG; XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8); - BVAR (&buffer_defaults, truncate_lines) = Qnil; - BVAR (&buffer_defaults, word_wrap) = Qnil; - BVAR (&buffer_defaults, ctl_arrow) = Qt; - BVAR (&buffer_defaults, bidi_display_reordering) = Qt; - BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil; - BVAR (&buffer_defaults, cursor_type) = Qt; - BVAR (&buffer_defaults, extra_line_spacing) = Qnil; - BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt; + BSET (&buffer_defaults, truncate_lines, Qnil); + BSET (&buffer_defaults, word_wrap, Qnil); + BSET (&buffer_defaults, ctl_arrow, Qt); + BSET (&buffer_defaults, bidi_display_reordering, Qt); + BSET (&buffer_defaults, bidi_paragraph_direction, Qnil); + BSET (&buffer_defaults, cursor_type, Qt); + BSET (&buffer_defaults, extra_line_spacing, Qnil); + BSET (&buffer_defaults, cursor_in_non_selected_windows, Qt); - BVAR (&buffer_defaults, enable_multibyte_characters) = Qt; - BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil; + BSET (&buffer_defaults, enable_multibyte_characters, Qt); + BSET (&buffer_defaults, buffer_file_coding_system, Qnil); XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70); XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0); - BVAR (&buffer_defaults, cache_long_line_scans) = Qnil; - BVAR (&buffer_defaults, file_truename) = Qnil; + BSET (&buffer_defaults, cache_long_line_scans, Qnil); + BSET (&buffer_defaults, file_truename, Qnil); XSETFASTINT (BVAR (&buffer_defaults, display_count), 0); XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0); XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0); - BVAR (&buffer_defaults, left_fringe_width) = Qnil; - BVAR (&buffer_defaults, right_fringe_width) = Qnil; - BVAR (&buffer_defaults, fringes_outside_margins) = Qnil; - BVAR (&buffer_defaults, scroll_bar_width) = Qnil; - BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt; - BVAR (&buffer_defaults, indicate_empty_lines) = Qnil; - BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil; - BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil; - BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil; - BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil; - BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil; - BVAR (&buffer_defaults, display_time) = Qnil; + BSET (&buffer_defaults, left_fringe_width, Qnil); + BSET (&buffer_defaults, right_fringe_width, Qnil); + BSET (&buffer_defaults, fringes_outside_margins, Qnil); + BSET (&buffer_defaults, scroll_bar_width, Qnil); + BSET (&buffer_defaults, vertical_scroll_bar_type, Qt); + BSET (&buffer_defaults, indicate_empty_lines, Qnil); + BSET (&buffer_defaults, indicate_buffer_boundaries, Qnil); + BSET (&buffer_defaults, fringe_indicator_alist, Qnil); + BSET (&buffer_defaults, fringe_cursor_alist, Qnil); + BSET (&buffer_defaults, scroll_up_aggressively, Qnil); + BSET (&buffer_defaults, scroll_down_aggressively, Qnil); + BSET (&buffer_defaults, display_time, Qnil); /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the buffer @@ -4970,28 +4980,28 @@ init_buffer_once (void) The local flag bits are in the local_var_flags slot of the buffer. */ /* Nothing can work if this isn't true */ - { verify (sizeof (EMACS_INT) == sizeof (Lisp_Object)); } + { verify (sizeof (EMACS_INT) == word_size); } /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); - XSETINT (BVAR (&buffer_local_flags, filename), -1); - XSETINT (BVAR (&buffer_local_flags, directory), -1); - XSETINT (BVAR (&buffer_local_flags, backed_up), -1); - XSETINT (BVAR (&buffer_local_flags, save_length), -1); - XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1); - XSETINT (BVAR (&buffer_local_flags, read_only), -1); - XSETINT (BVAR (&buffer_local_flags, major_mode), -1); - XSETINT (BVAR (&buffer_local_flags, mode_name), -1); - XSETINT (BVAR (&buffer_local_flags, undo_list), -1); - XSETINT (BVAR (&buffer_local_flags, mark_active), -1); - XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1); - XSETINT (BVAR (&buffer_local_flags, file_truename), -1); - XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1); - XSETINT (BVAR (&buffer_local_flags, file_format), -1); - XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1); - XSETINT (BVAR (&buffer_local_flags, display_count), -1); - XSETINT (BVAR (&buffer_local_flags, display_time), -1); - XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1); + BSET (&buffer_local_flags, filename, make_number (-1)); + BSET (&buffer_local_flags, directory, make_number (-1)); + BSET (&buffer_local_flags, backed_up, make_number (-1)); + BSET (&buffer_local_flags, save_length, make_number (-1)); + BSET (&buffer_local_flags, auto_save_file_name, make_number (-1)); + BSET (&buffer_local_flags, read_only, make_number (-1)); + BSET (&buffer_local_flags, major_mode, make_number (-1)); + BSET (&buffer_local_flags, mode_name, make_number (-1)); + BSET (&buffer_local_flags, undo_list, make_number (-1)); + BSET (&buffer_local_flags, mark_active, make_number (-1)); + BSET (&buffer_local_flags, point_before_scroll, make_number (-1)); + BSET (&buffer_local_flags, file_truename, make_number (-1)); + BSET (&buffer_local_flags, invisibility_spec, make_number (-1)); + BSET (&buffer_local_flags, file_format, make_number (-1)); + BSET (&buffer_local_flags, auto_save_file_format, make_number (-1)); + BSET (&buffer_local_flags, display_count, make_number (-1)); + BSET (&buffer_local_flags, display_time, make_number (-1)); + BSET (&buffer_local_flags, enable_multibyte_characters, make_number (-1)); idx = 1; XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; @@ -5047,7 +5057,7 @@ init_buffer_once (void) QSFundamental = build_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); - BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; + BSET (&buffer_defaults, major_mode, Qfundamental_mode); Qmode_class = intern_c_string ("mode-class"); @@ -5110,13 +5120,13 @@ init_buffer (void) len++; } - BVAR (current_buffer, directory) = make_unibyte_string (pwd, len); + BSET (current_buffer, directory, make_unibyte_string (pwd, len)); if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so that ENCODE_FILE correctly gets the original bytes. */ - BVAR (current_buffer, directory) - = string_to_multibyte (BVAR (current_buffer, directory)); + BSET (current_buffer, directory, + string_to_multibyte (BVAR (current_buffer, directory))); /* Add /: to the front of the name if it would otherwise be treated as magic. */ @@ -5127,11 +5137,11 @@ init_buffer (void) However, it is not necessary to turn / into /:/. So avoid doing that. */ && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) - BVAR (current_buffer, directory) - = concat2 (build_string ("/:"), BVAR (current_buffer, directory)); + BSET (current_buffer, directory, + concat2 (build_string ("/:"), BVAR (current_buffer, directory))); temp = get_minibuffer (0); - BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory); + BSET (XBUFFER (temp), directory, BVAR (current_buffer, directory)); free (pwd); } diff --git a/src/buffer.h b/src/buffer.h index cf571e06b53..7a6bddee5ec 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -21,6 +21,11 @@ along with GNU Emacs. If not, see . */ #include /* for off_t, time_t */ #include "systime.h" /* for EMACS_TIME */ +INLINE_HEADER_BEGIN +#ifndef BUFFER_INLINE +# define BUFFER_INLINE INLINE +#endif + /* Accessing the parameters of the current buffer. */ /* These macros come in pairs, one for the char position @@ -188,9 +193,6 @@ along with GNU Emacs. If not, see . */ /* FIXME: should we move this into ->text->auto_save_modiff? */ #define BUF_AUTOSAVE_MODIFF(buf) ((buf)->auto_save_modified) -/* Interval tree of buffer. */ -#define BUF_INTERVALS(buf) ((buf)->text->intervals) - /* Marker chain of buffer. */ #define BUF_MARKERS(buf) ((buf)->text->markers) @@ -475,6 +477,7 @@ struct buffer_text /* Most code should use this macro to access Lisp fields in struct buffer. */ #define BVAR(buf, field) ((buf)->INTERNAL_FIELD (field)) +#define BSET(buf, field, value) ((buf)->INTERNAL_FIELD (field) = (value)) /* This is the structure that the buffer Lisp object points to. */ @@ -773,7 +776,7 @@ struct buffer /* In an indirect buffer, this is -1. In an ordinary buffer, it's the number of indirect buffers that share our text; zero means that we're the only owner of this text. */ - ptrdiff_t indirections; + int indirections; /* A non-zero value in slot IDX means that per-buffer variable with index IDX has a local value in this buffer. The index IDX @@ -946,7 +949,47 @@ extern void mmap_set_vars (int); extern Lisp_Object Qbefore_change_functions; extern Lisp_Object Qafter_change_functions; extern Lisp_Object Qfirst_change_hook; - + +/* Get text properties of B. */ + +BUFFER_INLINE INTERVAL +buffer_get_intervals (struct buffer *b) +{ + eassert (b->text != NULL); + return b->text->intervals; +} + +/* Set text properties of B to I. */ + +BUFFER_INLINE void +buffer_set_intervals (struct buffer *b, INTERVAL i) +{ + eassert (b->text != NULL); + b->text->intervals = i; +} + +/* Set an appropriate overlay of B. */ + +BUFFER_INLINE void +buffer_set_overlays_before (struct buffer *b, struct Lisp_Overlay *o) +{ + b->overlays_before = o; +} + +BUFFER_INLINE void +buffer_set_overlays_after (struct buffer *b, struct Lisp_Overlay *o) +{ + b->overlays_after = o; +} + +/* Non-zero if current buffer has overlays. */ + +BUFFER_INLINE int +buffer_has_overlays (void) +{ + return current_buffer->overlays_before || current_buffer->overlays_after; +} + /* Return character code of multi-byte form at byte position POS. If POS doesn't point the head of valid multi-byte form, only the byte at POS is returned. No range checking. @@ -961,7 +1004,7 @@ extern Lisp_Object Qfirst_change_hook; the buffer to the next character after fetching this one. Instead, use either FETCH_CHAR_ADVANCE or STRING_CHAR_AND_LENGTH. */ -static inline int +BUFFER_INLINE int FETCH_MULTIBYTE_CHAR (ptrdiff_t pos) { unsigned char *p = ((pos >= GPT_BYTE ? GAP_SIZE : 0) @@ -973,7 +1016,7 @@ FETCH_MULTIBYTE_CHAR (ptrdiff_t pos) If POS doesn't point the head of valid multi-byte form, only the byte at POS is returned. No range checking. */ -static inline int +BUFFER_INLINE int BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos) { unsigned char *p @@ -986,15 +1029,15 @@ BUF_FETCH_MULTIBYTE_CHAR (struct buffer *buf, ptrdiff_t pos) /* Return the marker that stands for where OV starts in the buffer. */ -#define OVERLAY_START(OV) MVAR (XOVERLAY (OV), start) +#define OVERLAY_START(OV) XOVERLAY (OV)->start /* Return the marker that stands for where OV ends in the buffer. */ -#define OVERLAY_END(OV) MVAR (XOVERLAY (OV), end) +#define OVERLAY_END(OV) XOVERLAY (OV)->end /* Return the plist of overlay OV. */ -#define OVERLAY_PLIST(OV) MVAR (XOVERLAY (OV), plist) +#define OVERLAY_PLIST(OV) XOVERLAY (OV)->plist /* Return the actual buffer position for the marker P. We assume you know which buffer it's pointing into. */ @@ -1024,7 +1067,7 @@ extern int last_per_buffer_idx; #define FOR_EACH_PER_BUFFER_OBJECT_AT(offset) \ for (offset = PER_BUFFER_VAR_OFFSET (name); \ offset <= PER_BUFFER_VAR_OFFSET (cursor_in_non_selected_windows); \ - offset += sizeof (Lisp_Object)) + offset += word_size) /* Return the index of buffer-local variable VAR. Each per-buffer variable has an index > 0 associated with it, except when it always @@ -1090,7 +1133,7 @@ extern int last_per_buffer_idx; (*(Lisp_Object *)((OFFSET) + (char *) (BUFFER))) /* Downcase a character C, or make no change if that cannot be done. */ -static inline int +BUFFER_INLINE int downcase (int c) { Lisp_Object downcase_table = BVAR (current_buffer, downcase_table); @@ -1099,10 +1142,10 @@ downcase (int c) } /* 1 if C is upper case. */ -static inline int uppercasep (int c) { return downcase (c) != c; } +BUFFER_INLINE int uppercasep (int c) { return downcase (c) != c; } /* Upcase a character C known to be not upper case. */ -static inline int +BUFFER_INLINE int upcase1 (int c) { Lisp_Object upcase_table = BVAR (current_buffer, upcase_table); @@ -1111,8 +1154,10 @@ upcase1 (int c) } /* 1 if C is lower case. */ -static inline int lowercasep (int c) +BUFFER_INLINE int lowercasep (int c) { return !uppercasep (c) && upcase1 (c) != c; } /* Upcase a character C, or make no change if that cannot be done. */ -static inline int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); } +BUFFER_INLINE int upcase (int c) { return uppercasep (c) ? c : upcase1 (c); } + +INLINE_HEADER_END diff --git a/src/bytecode.c b/src/bytecode.c index 523d56bc97b..5ac8b4fa2bd 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -536,7 +536,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, stack.byte_string = bytestr; stack.pc = stack.byte_string_start = SDATA (bytestr); stack.constants = vector; - if (MAX_ALLOCA / sizeof (Lisp_Object) <= XFASTINT (maxdepth)) + if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth)) memory_full (SIZE_MAX); top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top); #if BYTE_MAINTAIN_TOP @@ -818,7 +818,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, && !EQ (val, Qunbound) && !XSYMBOL (sym)->redirect && !SYMBOL_CONSTANT_P (sym)) - SVAR (XSYMBOL (sym), val.value) = val; + SET_SYMBOL_VAL (XSYMBOL (sym), val); else { BEFORE_POTENTIAL_GC (); diff --git a/src/callint.c b/src/callint.c index 4b53b5df34b..e0133864674 100644 --- a/src/callint.c +++ b/src/callint.c @@ -372,7 +372,7 @@ invoke it. If KEYS is omitted or nil, the return value of Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; Vreal_this_command = save_real_this_command; - KVAR (current_kboard, Vlast_command) = save_last_command; + KSET (current_kboard, Vlast_command, save_last_command); temporarily_switch_to_single_kboard (NULL); return unbind_to (speccount, apply1 (function, specs)); @@ -465,7 +465,7 @@ invoke it. If KEYS is omitted or nil, the return value of } if (min (MOST_POSITIVE_FIXNUM, - min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)) + min (PTRDIFF_MAX, SIZE_MAX) / word_size) < nargs) memory_full (SIZE_MAX); @@ -843,7 +843,7 @@ invoke it. If KEYS is omitted or nil, the return value of Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; Vreal_this_command = save_real_this_command; - KVAR (current_kboard, Vlast_command) = save_last_command; + KSET (current_kboard, Vlast_command, save_last_command); { Lisp_Object val; diff --git a/src/callproc.c b/src/callproc.c index facca887772..10a80168fb2 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -427,8 +427,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) && SREF (path, 1) == ':') path = Fsubstring (path, make_number (2), Qnil); - SAFE_ALLOCA (new_argv, const unsigned char **, - (nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv); + new_argv = SAFE_ALLOCA ((nargs > 4 ? nargs - 2 : 2) * sizeof *new_argv); if (nargs > 4) { ptrdiff_t i; @@ -978,8 +977,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r Lisp_Object coding_systems; Lisp_Object val, *args2; ptrdiff_t i; - char *tempfile; - Lisp_Object tmpdir, pattern; + Lisp_Object tmpdir; if (STRINGP (Vtemporary_file_directory)) tmpdir = Vtemporary_file_directory; @@ -1003,8 +1001,8 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r { USE_SAFE_ALLOCA; - pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); - SAFE_ALLOCA (tempfile, char *, SBYTES (pattern) + 1); + Lisp_Object pattern = Fexpand_file_name (Vtemp_file_name_pattern, tmpdir); + char *tempfile = SAFE_ALLOCA (SBYTES (pattern) + 1); memcpy (tempfile, SDATA (pattern), SBYTES (pattern) + 1); coding_systems = Qt; @@ -1515,29 +1513,24 @@ egetenv (const char *var) void init_callproc_1 (void) { - char *data_dir = egetenv ("EMACSDATA"); - char *doc_dir = egetenv ("EMACSDOC"); #ifdef HAVE_NS const char *etc_dir = ns_etc_directory (); const char *path_exec = ns_exec_path (); #endif - Vdata_directory - = Ffile_name_as_directory (build_string (data_dir ? data_dir + Vdata_directory = decode_env_path ("EMACSDATA", #ifdef HAVE_NS - : (etc_dir ? etc_dir : PATH_DATA) -#else - : PATH_DATA + etc_dir ? etc_dir : #endif - )); - Vdoc_directory - = Ffile_name_as_directory (build_string (doc_dir ? doc_dir + PATH_DATA); + Vdata_directory = Ffile_name_as_directory (Fcar (Vdata_directory)); + + Vdoc_directory = decode_env_path ("EMACSDOC", #ifdef HAVE_NS - : (etc_dir ? etc_dir : PATH_DOC) -#else - : PATH_DOC + etc_dir ? etc_dir : #endif - )); + PATH_DOC); + Vdoc_directory = Ffile_name_as_directory (Fcar (Vdoc_directory)); /* Check the EMACSPATH environment variable, defaulting to the PATH_EXEC path from epaths.h. */ @@ -1578,7 +1571,7 @@ init_callproc (void) Lisp_Object tem; tem = Fexpand_file_name (build_string ("lib-src"), Vinstallation_directory); -#ifndef DOS_NT +#ifndef MSDOS /* MSDOS uses wrapped binaries, so don't do this. */ if (NILP (Fmember (tem, Vexec_path))) { @@ -1595,7 +1588,7 @@ init_callproc (void) } Vexec_directory = Ffile_name_as_directory (tem); -#endif /* not DOS_NT */ +#endif /* not MSDOS */ /* Maybe use ../etc as well as ../lib-src. */ if (data_dir == 0) diff --git a/src/casefiddle.c b/src/casefiddle.c index 19fbc832288..81e84252b72 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -114,12 +114,11 @@ casify_object (enum case_action flag, Lisp_Object obj) ptrdiff_t i, i_byte, size = SCHARS (obj); int len; USE_SAFE_ALLOCA; - unsigned char *dst, *o; ptrdiff_t o_size = (size < STRING_BYTES_BOUND / MAX_MULTIBYTE_LENGTH ? size * MAX_MULTIBYTE_LENGTH : STRING_BYTES_BOUND); - SAFE_ALLOCA (dst, void *, o_size); - o = dst; + unsigned char *dst = SAFE_ALLOCA (o_size); + unsigned char *o = dst; for (i = i_byte = 0; i < size; i++, i_byte += len) { diff --git a/src/casetab.c b/src/casetab.c index 86dbca4d026..4b29c091ca9 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -158,10 +158,10 @@ set_case_table (Lisp_Object table, int standard) } else { - BVAR (current_buffer, downcase_table) = table; - BVAR (current_buffer, upcase_table) = up; - BVAR (current_buffer, case_canon_table) = canon; - BVAR (current_buffer, case_eqv_table) = eqv; + BSET (current_buffer, downcase_table, table); + BSET (current_buffer, upcase_table, up); + BSET (current_buffer, case_canon_table, canon); + BSET (current_buffer, case_eqv_table, eqv); } return table; diff --git a/src/category.c b/src/category.c index 7d0f72d284d..13c6e46d283 100644 --- a/src/category.c +++ b/src/category.c @@ -29,6 +29,9 @@ along with GNU Emacs. If not, see . */ table. Read comments in the file category.h to understand them. */ #include + +#define CATEGORY_INLINE EXTERN_INLINE + #include #include #include "lisp.h" @@ -282,7 +285,7 @@ Return TABLE. */) { int idx; table = check_category_table (table); - BVAR (current_buffer, category_table) = table; + BSET (current_buffer, category_table, table); /* Indicate that this buffer now has a specified category table. */ idx = PER_BUFFER_VAR_IDX (category_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); diff --git a/src/category.h b/src/category.h index 580e516afd9..f29034acff1 100644 --- a/src/category.h +++ b/src/category.h @@ -53,6 +53,11 @@ along with GNU Emacs. If not, see . */ The second extra slot is a version number of the category table. But, for the moment, we are not using this slot. */ +INLINE_HEADER_BEGIN +#ifndef CATEGORY_INLINE +# define CATEGORY_INLINE INLINE +#endif + #define CATEGORYP(x) RANGED_INTEGERP (0x20, x, 0x7E) #define CHECK_CATEGORY(x) \ @@ -79,7 +84,7 @@ along with GNU Emacs. If not, see . */ >> ((category) % 8)) & 1) /* Return 1 if category set of CH contains CATEGORY, else return 0. */ -static inline int +CATEGORY_INLINE int CHAR_HAS_CATEGORY (int ch, int category) { Lisp_Object category_set = CATEGORY_SET (ch); @@ -108,3 +113,5 @@ CHAR_HAS_CATEGORY (int ch, int category) && word_boundary_p (c1, c2)) extern int word_boundary_p (int, int); + +INLINE_HEADER_END diff --git a/src/character.c b/src/character.c index f4c74a93d39..b2acf36ec15 100644 --- a/src/character.c +++ b/src/character.c @@ -29,6 +29,8 @@ along with GNU Emacs. If not, see . */ #include #endif +#define CHARACTER_INLINE EXTERN_INLINE + #include #ifdef emacs @@ -256,6 +258,9 @@ multibyte_char_to_unibyte_safe (int c) DEFUN ("characterp", Fcharacterp, Scharacterp, 1, 2, 0, doc: /* Return non-nil if OBJECT is a character. +In Emacs Lisp, characters are represented by character codes, which +are non-negative integers. The function `max-char' returns the +maximum character code. usage: (characterp OBJECT) */) (Lisp_Object object, Lisp_Object ignore) { @@ -918,12 +923,10 @@ usage: (unibyte-string &rest BYTES) */) (ptrdiff_t n, Lisp_Object *args) { ptrdiff_t i; - unsigned char *buf, *p; Lisp_Object str; USE_SAFE_ALLOCA; - - SAFE_ALLOCA (buf, unsigned char *, n); - p = buf; + unsigned char *buf = SAFE_ALLOCA (n); + unsigned char *p = buf; for (i = 0; i < n; i++) { diff --git a/src/character.h b/src/character.h index 2cfeff85fee..332dfee373a 100644 --- a/src/character.h +++ b/src/character.h @@ -25,6 +25,11 @@ along with GNU Emacs. If not, see . */ #include +INLINE_HEADER_BEGIN +#ifndef CHARACTER_INLINE +# define CHARACTER_INLINE INLINE +#endif + /* character code 1st byte byte sequence -------------- -------- ------------- 0-7F 00..7F 0xxxxxxx @@ -570,7 +575,7 @@ along with GNU Emacs. If not, see . */ #define SANE_TAB_WIDTH(buf) \ sanitize_tab_width (XFASTINT (BVAR (buf, tab_width))) -static inline int +CHARACTER_INLINE int sanitize_tab_width (EMACS_INT width) { return 0 < width && width <= 1000 ? width : 8; @@ -591,7 +596,7 @@ sanitize_tab_width (EMACS_INT width) /* Return a non-outlandish value for a character width. */ -static inline int +CHARACTER_INLINE int sanitize_char_width (EMACS_INT width) { return 0 <= width && width <= 1000 ? width : 1000; @@ -695,4 +700,6 @@ extern Lisp_Object string_escape_byte8 (Lisp_Object); #define GET_TRANSLATION_TABLE(id) \ (XCDR(XVECTOR(Vtranslation_table_vector)->contents[(id)])) +INLINE_HEADER_END + #endif /* EMACS_CHARACTER_H */ diff --git a/src/charset.c b/src/charset.c index b621109b75d..fbbcefc4915 100644 --- a/src/charset.c +++ b/src/charset.c @@ -26,6 +26,8 @@ along with GNU Emacs. If not, see . */ #include +#define CHARSET_INLINE EXTERN_INLINE + #include #include #include @@ -272,8 +274,8 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, { int n = CODE_POINT_TO_INDEX (charset, max_code) + 1; - vec = CHARSET_DECODER (charset) - = Fmake_vector (make_number (n), make_number (-1)); + vec = Fmake_vector (make_number (n), make_number (-1)); + set_charset_attr (charset, charset_decoder, vec); } else { @@ -285,10 +287,10 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries, else { table = Fmake_char_table (Qnil, Qnil); - if (charset->method == CHARSET_METHOD_MAP) - CHARSET_ENCODER (charset) = table; - else - CHARSET_DEUNIFIER (charset) = table; + set_charset_attr (charset, + (charset->method == CHARSET_METHOD_MAP + ? charset_encoder : charset_deunifier), + table); } } else @@ -501,8 +503,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ - SAFE_ALLOCA (head, struct charset_map_entries *, - sizeof (struct charset_map_entries)); + head = SAFE_ALLOCA (sizeof *head); entries = head; memset (entries, 0, sizeof (struct charset_map_entries)); @@ -533,8 +534,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile, int co if (n_entries > 0 && (n_entries % 0x10000) == 0) { - SAFE_ALLOCA (entries->next, struct charset_map_entries *, - sizeof (struct charset_map_entries)); + entries->next = SAFE_ALLOCA (sizeof *entries->next); entries = entries->next; memset (entries, 0, sizeof (struct charset_map_entries)); n_entries = 0; @@ -570,8 +570,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont /* Use SAFE_ALLOCA instead of alloca, as `charset_map_entries' is large (larger than MAX_ALLOCA). */ - SAFE_ALLOCA (head, struct charset_map_entries *, - sizeof (struct charset_map_entries)); + head = SAFE_ALLOCA (sizeof *head); entries = head; memset (entries, 0, sizeof (struct charset_map_entries)); @@ -602,8 +601,7 @@ load_charset_map_from_vector (struct charset *charset, Lisp_Object vec, int cont if (n_entries > 0 && (n_entries % 0x10000) == 0) { - SAFE_ALLOCA (entries->next, struct charset_map_entries *, - sizeof (struct charset_map_entries)); + entries->next = SAFE_ALLOCA (sizeof *entries->next); entries = entries->next; memset (entries, 0, sizeof (struct charset_map_entries)); } @@ -1133,7 +1131,7 @@ usage: (define-charset-internal ...) */) { new_definition_p = 0; id = XFASTINT (CHARSET_SYMBOL_ID (args[charset_arg_name])); - HASH_VALUE (hash_table, charset.hash_index) = attrs; + set_hash_value (hash_table, charset.hash_index, attrs); } else { @@ -1336,7 +1334,7 @@ DEFUN ("set-charset-plist", Fset_charset_plist, Sset_charset_plist, 2, 2, 0, Lisp_Object attrs; CHECK_CHARSET_GET_ATTR (charset, attrs); - CHARSET_ATTR_PLIST (attrs) = plist; + ASET (attrs, charset_plist, plist); return plist; } @@ -1375,7 +1373,7 @@ Optional third argument DEUNIFY, if non-nil, means to de-unify CHARSET. */) { if (! STRINGP (unify_map) && ! VECTORP (unify_map)) signal_error ("Bad unify-map", unify_map); - CHARSET_UNIFY_MAP (cs) = unify_map; + set_charset_attr (cs, charset_unify_map, unify_map); } if (NILP (Vchar_unify_table)) Vchar_unify_table = Fmake_char_table (Qnil, Qnil); diff --git a/src/charset.h b/src/charset.h index 516582a3f3d..4ef8ddc2c33 100644 --- a/src/charset.h +++ b/src/charset.h @@ -29,6 +29,11 @@ along with GNU Emacs. If not, see . */ #include +INLINE_HEADER_BEGIN +#ifndef CHARSET_INLINE +# define CHARSET_INLINE INLINE +#endif + /* Index to arguments of Fdefine_charset_internal. */ enum define_charset_arg_index @@ -325,6 +330,13 @@ extern int emacs_mule_charset[256]; #define CHARSET_DEUNIFIER(charset) \ (CHARSET_ATTR_DEUNIFIER (CHARSET_ATTRIBUTES (charset))) +CHARSET_INLINE void +set_charset_attr (struct charset *charset, enum charset_attr_index idx, + Lisp_Object val) +{ + ASET (CHARSET_ATTRIBUTES (charset), idx, val); +} + /* Nonzero if OBJ is a valid charset symbol. */ #define CHARSETP(obj) (CHARSET_SYMBOL_HASH_INDEX (obj) >= 0) @@ -534,4 +546,6 @@ extern void map_charset_chars (void (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, struct charset *, unsigned, unsigned); +INLINE_HEADER_END + #endif /* EMACS_CHARSET_H */ diff --git a/src/chartab.c b/src/chartab.c index e1252962612..c022bc03e66 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -945,11 +945,11 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), DEFUN ("map-char-table", Fmap_char_table, Smap_char_table, 2, 2, 0, - doc: /* -Call FUNCTION for each character in CHAR-TABLE that has non-nil value. -FUNCTION is called with two arguments--a key and a value. -The key is a character code or a cons of character codes specifying a -range of characters that have the same value. */) + doc: /* Call FUNCTION for each character in CHAR-TABLE that has non-nil value. +FUNCTION is called with two arguments, KEY and VALUE. +KEY is a character code or a cons of character codes specifying a +range of characters that have the same value. +VALUE is what (char-table-range CHAR-TABLE KEY) returns. */) (Lisp_Object function, Lisp_Object char_table) { CHECK_CHAR_TABLE (char_table); diff --git a/src/cmds.c b/src/cmds.c index 4512f562064..24778fae6e3 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -301,7 +301,7 @@ At the end, it runs `post-self-insert-hook'. */) added be explicit calls to undo-boundary. */ && EQ (BVAR (current_buffer, undo_list), last_undo_boundary)) /* Remove the undo_boundary that was just pushed. */ - BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, XCDR (BVAR (current_buffer, undo_list))); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) @@ -447,12 +447,11 @@ internal_self_insert (int c, EMACS_INT n) and the hook has a non-nil `no-self-insert' property, return right away--don't really self-insert. */ if (SYMBOLP (sym) && ! NILP (sym) - && ! NILP (SVAR (XSYMBOL (sym), function)) - && SYMBOLP (SVAR (XSYMBOL (sym), function))) + && ! NILP (XSYMBOL (sym)->function) + && SYMBOLP (XSYMBOL (sym)->function)) { Lisp_Object prop; - prop = Fget (SVAR (XSYMBOL (sym), function), - intern ("no-self-insert")); + prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert")); if (! NILP (prop)) return 1; } diff --git a/src/coding.c b/src/coding.c index e4ed65079d9..c601a18b26e 100644 --- a/src/coding.c +++ b/src/coding.c @@ -2674,8 +2674,8 @@ encode_coding_emacs_mule (struct coding_system *coding) CODING_GET_INFO (coding, attrs, charset_list); if (! EQ (charset_list, Vemacs_mule_charset_list)) { - CODING_ATTR_CHARSET_LIST (attrs) - = charset_list = Vemacs_mule_charset_list; + charset_list = Vemacs_mule_charset_list; + ASET (attrs, coding_attr_charset_list, charset_list); } while (charbuf < charbuf_end) @@ -2967,8 +2967,8 @@ setup_iso_safe_charsets (Lisp_Object attrs) if ((flags & CODING_ISO_FLAG_FULL_SUPPORT) && ! EQ (charset_list, Viso_2022_charset_list)) { - CODING_ATTR_CHARSET_LIST (attrs) - = charset_list = Viso_2022_charset_list; + charset_list = Viso_2022_charset_list; + ASET (attrs, coding_attr_charset_list, charset_list); ASET (attrs, coding_attr_safe_charsets, Qnil); } @@ -7102,8 +7102,17 @@ decode_coding (struct coding_system *coding) set_buffer_internal (XBUFFER (coding->dst_object)); if (GPT != PT) move_gap_both (PT, PT_BYTE); + + /* We must disable undo_list in order to record the whole insert + transaction via record_insert at the end. But doing so also + disables the recording of the first change to the undo_list. + Therefore we check for first change here and record it via + record_first_change if needed. */ + if (MODIFF <= SAVE_MODIFF) + record_first_change (); + undo_list = BVAR (current_buffer, undo_list); - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, undo_list, Qt); } coding->consumed = coding->consumed_char = 0; @@ -7200,7 +7209,7 @@ decode_coding (struct coding_system *coding) decode_eol (coding); if (BUFFERP (coding->dst_object)) { - BVAR (current_buffer, undo_list) = undo_list; + BSET (current_buffer, undo_list, undo_list); record_insert (coding->dst_pos, coding->produced_char); } return coding->result; @@ -7568,8 +7577,8 @@ make_conversion_work_buffer (int multibyte) doesn't compile new regexps. */ Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); Ferase_buffer (); - BVAR (current_buffer, undo_list) = Qt; - BVAR (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; + BSET (current_buffer, undo_list, Qt); + BSET (current_buffer, enable_multibyte_characters, multibyte ? Qt : Qnil); set_buffer_internal (current); return workbuf; } @@ -9294,9 +9303,9 @@ DEFUN ("set-terminal-coding-system-internal", Fset_terminal_coding_system_intern terminal_coding->src_multibyte = 1; terminal_coding->dst_multibyte = 0; if (terminal_coding->common_flags & CODING_REQUIRE_ENCODING_MASK) - term->charset_list = coding_charset_list (terminal_coding); + TSET (term, charset_list, coding_charset_list (terminal_coding)); else - term->charset_list = Fcons (make_number (charset_ascii), Qnil); + TSET (term, charset_list, Fcons (make_number (charset_ascii), Qnil)); return Qnil; } @@ -9603,16 +9612,16 @@ usage: (define-coding-system-internal ...) */) name = args[coding_arg_name]; CHECK_SYMBOL (name); - CODING_ATTR_BASE_NAME (attrs) = name; + ASET (attrs, coding_attr_base_name, name); val = args[coding_arg_mnemonic]; if (! STRINGP (val)) CHECK_CHARACTER (val); - CODING_ATTR_MNEMONIC (attrs) = val; + ASET (attrs, coding_attr_mnemonic, val); coding_type = args[coding_arg_coding_type]; CHECK_SYMBOL (coding_type); - CODING_ATTR_TYPE (attrs) = coding_type; + ASET (attrs, coding_attr_type, coding_type); charset_list = args[coding_arg_charset_list]; if (SYMBOLP (charset_list)) @@ -9659,49 +9668,49 @@ usage: (define-coding-system-internal ...) */) max_charset_id = charset->id; } } - CODING_ATTR_CHARSET_LIST (attrs) = charset_list; + ASET (attrs, coding_attr_charset_list, charset_list); safe_charsets = make_uninit_string (max_charset_id + 1); memset (SDATA (safe_charsets), 255, max_charset_id + 1); for (tail = charset_list; CONSP (tail); tail = XCDR (tail)) SSET (safe_charsets, XFASTINT (XCAR (tail)), 0); - CODING_ATTR_SAFE_CHARSETS (attrs) = safe_charsets; + ASET (attrs, coding_attr_safe_charsets, safe_charsets); - CODING_ATTR_ASCII_COMPAT (attrs) = args[coding_arg_ascii_compatible_p]; + ASET (attrs, coding_attr_ascii_compat, args[coding_arg_ascii_compatible_p]); val = args[coding_arg_decode_translation_table]; if (! CHAR_TABLE_P (val) && ! CONSP (val)) CHECK_SYMBOL (val); - CODING_ATTR_DECODE_TBL (attrs) = val; + ASET (attrs, coding_attr_decode_tbl, val); val = args[coding_arg_encode_translation_table]; if (! CHAR_TABLE_P (val) && ! CONSP (val)) CHECK_SYMBOL (val); - CODING_ATTR_ENCODE_TBL (attrs) = val; + ASET (attrs, coding_attr_encode_tbl, val); val = args[coding_arg_post_read_conversion]; CHECK_SYMBOL (val); - CODING_ATTR_POST_READ (attrs) = val; + ASET (attrs, coding_attr_post_read, val); val = args[coding_arg_pre_write_conversion]; CHECK_SYMBOL (val); - CODING_ATTR_PRE_WRITE (attrs) = val; + ASET (attrs, coding_attr_pre_write, val); val = args[coding_arg_default_char]; if (NILP (val)) - CODING_ATTR_DEFAULT_CHAR (attrs) = make_number (' '); + ASET (attrs, coding_attr_default_char, make_number (' ')); else { CHECK_CHARACTER (val); - CODING_ATTR_DEFAULT_CHAR (attrs) = val; + ASET (attrs, coding_attr_default_char, val); } val = args[coding_arg_for_unibyte]; - CODING_ATTR_FOR_UNIBYTE (attrs) = NILP (val) ? Qnil : Qt; + ASET (attrs, coding_attr_for_unibyte, NILP (val) ? Qnil : Qt); val = args[coding_arg_plist]; CHECK_LIST (val); - CODING_ATTR_PLIST (attrs) = val; + ASET (attrs, coding_attr_plist, val); if (EQ (coding_type, Qcharset)) { @@ -9726,7 +9735,7 @@ usage: (define-coding-system-internal ...) */) int idx = (dim - 1) * 4; if (CHARSET_ASCII_COMPATIBLE_P (charset)) - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); for (i = charset->code_space[idx]; i <= charset->code_space[idx + 1]; i++) @@ -9824,7 +9833,7 @@ usage: (define-coding-system-internal ...) */) { Lisp_Object bom, endian; - CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; + ASET (attrs, coding_attr_ascii_compat, Qnil); if (nargs < coding_arg_utf16_max) goto short_args; @@ -9877,7 +9886,7 @@ usage: (define-coding-system-internal ...) */) CHECK_CHARSET_GET_CHARSET (val, charset); ASET (initial, i, make_number (CHARSET_ID (charset))); if (i == 0 && CHARSET_ASCII_COMPATIBLE_P (charset)) - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); } else ASET (initial, i, make_number (-1)); @@ -9938,13 +9947,13 @@ usage: (define-coding-system-internal ...) */) } if (category != coding_category_iso_8_1 && category != coding_category_iso_8_2) - CODING_ATTR_ASCII_COMPAT (attrs) = Qnil; + ASET (attrs, coding_attr_ascii_compat, Qnil); } else if (EQ (coding_type, Qemacs_mule)) { if (EQ (args[coding_arg_charset_list], Qemacs_mule)) ASET (attrs, coding_attr_emacs_mule_full, Qt); - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); category = coding_category_emacs_mule; } else if (EQ (coding_type, Qshift_jis)) @@ -9961,7 +9970,7 @@ usage: (define-coding-system-internal ...) */) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); if (CHARSET_ASCII_COMPATIBLE_P (charset)) - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); charset_list = XCDR (charset_list); charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); @@ -9999,7 +10008,7 @@ usage: (define-coding-system-internal ...) */) error ("Dimension of charset %s is not one", SDATA (SYMBOL_NAME (CHARSET_NAME (charset)))); if (CHARSET_ASCII_COMPATIBLE_P (charset)) - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); charset_list = XCDR (charset_list); charset = CHARSET_FROM_ID (XINT (XCAR (charset_list))); @@ -10013,7 +10022,7 @@ usage: (define-coding-system-internal ...) */) else if (EQ (coding_type, Qraw_text)) { category = coding_category_raw_text; - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); } else if (EQ (coding_type, Qutf_8)) { @@ -10033,7 +10042,7 @@ usage: (define-coding-system-internal ...) */) } ASET (attrs, coding_attr_utf_bom, bom); if (NILP (bom)) - CODING_ATTR_ASCII_COMPAT (attrs) = Qt; + ASET (attrs, coding_attr_ascii_compat, Qt); category = (CONSP (bom) ? coding_category_utf_8_auto : NILP (bom) ? coding_category_utf_8_nosig @@ -10045,14 +10054,15 @@ usage: (define-coding-system-internal ...) */) error ("Invalid coding system type: %s", SDATA (SYMBOL_NAME (coding_type))); - CODING_ATTR_CATEGORY (attrs) = make_number (category); - CODING_ATTR_PLIST (attrs) - = Fcons (QCcategory, Fcons (AREF (Vcoding_category_table, category), - CODING_ATTR_PLIST (attrs))); - CODING_ATTR_PLIST (attrs) - = Fcons (QCascii_compatible_p, - Fcons (CODING_ATTR_ASCII_COMPAT (attrs), - CODING_ATTR_PLIST (attrs))); + ASET (attrs, coding_attr_category, make_number (category)); + ASET (attrs, coding_attr_plist, + Fcons (QCcategory, + Fcons (AREF (Vcoding_category_table, category), + CODING_ATTR_PLIST (attrs)))); + ASET (attrs, coding_attr_plist, + Fcons (QCascii_compatible_p, + Fcons (CODING_ATTR_ASCII_COMPAT (attrs), + CODING_ATTR_PLIST (attrs)))); eol_type = args[coding_arg_eol_type]; if (! NILP (eol_type) @@ -10126,7 +10136,7 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put, { if (! STRINGP (val)) CHECK_CHARACTER (val); - CODING_ATTR_MNEMONIC (attrs) = val; + ASET (attrs, coding_attr_mnemonic, val); } else if (EQ (prop, QCdefault_char)) { @@ -10134,37 +10144,37 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put, val = make_number (' '); else CHECK_CHARACTER (val); - CODING_ATTR_DEFAULT_CHAR (attrs) = val; + ASET (attrs, coding_attr_default_char, val); } else if (EQ (prop, QCdecode_translation_table)) { if (! CHAR_TABLE_P (val) && ! CONSP (val)) CHECK_SYMBOL (val); - CODING_ATTR_DECODE_TBL (attrs) = val; + ASET (attrs, coding_attr_decode_tbl, val); } else if (EQ (prop, QCencode_translation_table)) { if (! CHAR_TABLE_P (val) && ! CONSP (val)) CHECK_SYMBOL (val); - CODING_ATTR_ENCODE_TBL (attrs) = val; + ASET (attrs, coding_attr_encode_tbl, val); } else if (EQ (prop, QCpost_read_conversion)) { CHECK_SYMBOL (val); - CODING_ATTR_POST_READ (attrs) = val; + ASET (attrs, coding_attr_post_read, val); } else if (EQ (prop, QCpre_write_conversion)) { CHECK_SYMBOL (val); - CODING_ATTR_PRE_WRITE (attrs) = val; + ASET (attrs, coding_attr_pre_write, val); } else if (EQ (prop, QCascii_compatible_p)) { - CODING_ATTR_ASCII_COMPAT (attrs) = val; + ASET (attrs, coding_attr_ascii_compat, val); } - CODING_ATTR_PLIST (attrs) - = Fplist_put (CODING_ATTR_PLIST (attrs), prop, val); + ASET (attrs, coding_attr_plist, + Fplist_put (CODING_ATTR_PLIST (attrs), prop, val)); return val; } diff --git a/src/composite.c b/src/composite.c index 485e51467ca..4e90e9bb914 100644 --- a/src/composite.c +++ b/src/composite.c @@ -23,6 +23,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ #include + +#define COMPOSITE_INLINE EXTERN_INLINE + #include #include "lisp.h" #include "character.h" @@ -762,7 +765,7 @@ composition_gstring_width (Lisp_Object gstring, ptrdiff_t from, ptrdiff_t to, } metrics->width = metrics->lbearing = metrics->rbearing = 0; } - for (glyph = &LGSTRING_GLYPH (gstring, from); from < to; from++, glyph++) + for (glyph = lgstring_glyph_addr (gstring, from); from < to; from++, glyph++) { int x; @@ -906,7 +909,7 @@ static Lisp_Object autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t limit, struct window *win, struct face *face, Lisp_Object string) { ptrdiff_t count = SPECPDL_INDEX (); - FRAME_PTR f = XFRAME (WVAR (win, frame)); + FRAME_PTR f = XFRAME (win->frame); Lisp_Object pos = make_number (charpos); ptrdiff_t to; ptrdiff_t pt = PT, pt_byte = PT_BYTE; @@ -942,7 +945,7 @@ autocmp_chars (Lisp_Object rule, ptrdiff_t charpos, ptrdiff_t bytepos, ptrdiff_t } else #endif /* not HAVE_WINDOW_SYSTEM */ - font_object = WVAR (win, frame); + font_object = win->frame; lgstring = Fcomposition_get_gstring (pos, make_number (to), font_object, string); if (NILP (LGSTRING_ID (lgstring))) diff --git a/src/composite.h b/src/composite.h index 845411f5cde..6a7e0a5e2c7 100644 --- a/src/composite.h +++ b/src/composite.h @@ -25,6 +25,11 @@ along with GNU Emacs. If not, see . */ #ifndef EMACS_COMPOSITE_H #define EMACS_COMPOSITE_H +INLINE_HEADER_BEGIN +#ifndef COMPOSITE_INLINE +# define COMPOSITE_INLINE INLINE +#endif + /* Methods to display a sequence of components of a composition. */ enum composition_method { /* Compose relatively without alternate characters. */ @@ -247,6 +252,11 @@ extern void compose_text (ptrdiff_t, ptrdiff_t, Lisp_Object, Lisp_Object, #define LGSTRING_GLYPH_LEN(lgs) (ASIZE ((lgs)) - 2) #define LGSTRING_GLYPH(lgs, idx) AREF ((lgs), (idx) + 2) #define LGSTRING_SET_GLYPH(lgs, idx, val) ASET ((lgs), (idx) + 2, (val)) +COMPOSITE_INLINE Lisp_Object * +lgstring_glyph_addr (Lisp_Object lgs, ptrdiff_t idx) +{ + return aref_addr (lgs, idx + 2); +} /* Vector size of Lispy glyph. */ enum lglyph_indices @@ -316,4 +326,6 @@ extern int composition_update_it (struct composition_it *, extern ptrdiff_t composition_adjust_point (ptrdiff_t, ptrdiff_t); +INLINE_HEADER_END + #endif /* not EMACS_COMPOSITE_H */ diff --git a/src/conf_post.h b/src/conf_post.h index c4a27c10d85..ead7298e98d 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -88,7 +88,7 @@ along with GNU Emacs. If not, see . */ */ #undef HAVE_RANDOM #undef HAVE_RINT -#endif +#endif /* HPUX */ #ifdef IRIX6_5 #ifdef emacs @@ -98,6 +98,46 @@ char *_getpty(); #undef SA_RESTART /* not the same as defining BROKEN_SA_RESTART */ #endif /* IRIX6_5 */ +#ifdef MSDOS +#ifndef __DJGPP__ +You lose; /* Emacs for DOS must be compiled with DJGPP */ +#endif +#define _NAIVE_DOS_REGS + +/* Start of gnulib-related stuff */ + +/* lib/ftoastr.c wants strtold, but DJGPP only has _strtold. DJGPP > + 2.03 has it, but it also has _strtold as a stub that jumps to + strtold, so use _strtold in all versions. */ +#define strtold _strtold + +#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3 +# define HAVE_LSTAT 1 +#else +# define lstat stat +#endif +/* End of gnulib-related stuff. */ + +/* Define one of these for easier conditionals. */ +#ifdef HAVE_X_WINDOWS +/* We need a little extra space, see ../../lisp/loadup.el and the + commentary below, in the non-X branch. The 140KB number was + measured on GNU/Linux and on MS-Windows. */ +#define SYSTEM_PURESIZE_EXTRA (-170000+140000) +#else +/* We need a little extra space, see ../../lisp/loadup.el. + As of 20091024, DOS-specific files use up 62KB of pure space. But + overall, we end up wasting 130KB of pure space, because + BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including + non-DOS specific files and load history; the latter is about 55K, + but depends on the depth of the top-level Emacs directory in the + directory tree). Given the unknown policy of different DPMI + hosts regarding loading of untouched pages, I'm not going to risk + enlarging Emacs footprint by another 100+ KBytes. */ +#define SYSTEM_PURESIZE_EXTRA (-170000+65000) +#endif +#endif /* MSDOS */ + #ifdef USG5_4 /* Get FIONREAD from . Get to get struct tchars. But get first to make sure ttold.h doesn't interfere. */ @@ -173,4 +213,21 @@ char *_getpty(); #undef noinline #endif +#define INLINE _GL_INLINE +#define EXTERN_INLINE _GL_EXTERN_INLINE +#define INLINE_HEADER_BEGIN _GL_INLINE_HEADER_BEGIN +#define INLINE_HEADER_END _GL_INLINE_HEADER_END + +/* Use this to suppress gcc's `...may be used before initialized' warnings. */ +#ifdef lint +/* Use CODE only if lint checking is in effect. */ +# define IF_LINT(Code) Code +/* Assume that the expression COND is true. This differs in intent + from 'assert', as it is a message from the programmer to the compiler. */ +# define lint_assume(cond) ((cond) ? (void) 0 : abort ()) +#else +# define IF_LINT(Code) /* empty */ +# define lint_assume(cond) ((void) (0 && (cond))) +#endif + /* conf_post.h ends here */ diff --git a/src/data.c b/src/data.c index 4c6f7fe3eae..d0ef5734abc 100644 --- a/src/data.c +++ b/src/data.c @@ -562,7 +562,7 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return (EQ (SVAR (XSYMBOL (symbol), function), Qunbound) ? Qnil : Qt); + return EQ (XSYMBOL (symbol)->function, Qunbound) ? Qnil : Qt; } DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, @@ -585,7 +585,7 @@ Return SYMBOL. */) CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) xsignal1 (Qsetting_constant, symbol); - SVAR (XSYMBOL (symbol), function) = Qunbound; + set_symbol_function (symbol, Qunbound); return symbol; } @@ -594,8 +594,8 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - if (!EQ (SVAR (XSYMBOL (symbol), function), Qunbound)) - return SVAR (XSYMBOL (symbol), function); + if (!EQ (XSYMBOL (symbol)->function, Qunbound)) + return XSYMBOL (symbol)->function; xsignal1 (Qvoid_function, symbol); } @@ -604,7 +604,7 @@ DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, (register Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return SVAR (XSYMBOL (symbol), plist); + return XSYMBOL (symbol)->plist; } DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, @@ -628,7 +628,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, if (NILP (symbol) || EQ (symbol, Qt)) xsignal1 (Qsetting_constant, symbol); - function = SVAR (XSYMBOL (symbol), function); + function = XSYMBOL (symbol)->function; if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); @@ -636,13 +636,13 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, if (CONSP (function) && EQ (XCAR (function), Qautoload)) Fput (symbol, Qautoload, XCDR (function)); - SVAR (XSYMBOL (symbol), function) = definition; + set_symbol_function (symbol, definition); /* Handle automatic advice activation. */ - if (CONSP (SVAR (XSYMBOL (symbol), plist)) + if (CONSP (XSYMBOL (symbol)->plist) && !NILP (Fget (symbol, Qad_advice_info))) { call2 (Qad_activate_internal, symbol, Qnil); - definition = SVAR (XSYMBOL (symbol), function); + definition = XSYMBOL (symbol)->function; } return definition; } @@ -657,8 +657,8 @@ The return value is undefined. */) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (CONSP (SVAR (XSYMBOL (symbol), function)) - && EQ (XCAR (SVAR (XSYMBOL (symbol), function)), Qautoload)) + if (CONSP (XSYMBOL (symbol)->function) + && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload)) LOADHIST_ATTACH (Fcons (Qt, symbol)); if (!NILP (Vpurify_flag) /* If `definition' is a keymap, immutable (and copying) is wrong. */ @@ -679,7 +679,7 @@ DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0, (register Lisp_Object symbol, Lisp_Object newplist) { CHECK_SYMBOL (symbol); - SVAR (XSYMBOL (symbol), plist) = newplist; + set_symbol_plist (symbol, newplist); return newplist; } @@ -808,10 +808,12 @@ indirect_variable (struct Lisp_Symbol *symbol) DEFUN ("indirect-variable", Findirect_variable, Sindirect_variable, 1, 1, 0, doc: /* Return the variable at the end of OBJECT's variable chain. -If OBJECT is a symbol, follow all variable indirections and return the final -variable. If OBJECT is not a symbol, just return it. -Signal a cyclic-variable-indirection error if there is a loop in the -variable chain of symbols. */) +If OBJECT is a symbol, follow its variable indirections (if any), and +return the variable at the end of the chain of aliases. See Info node +`(elisp)Variable Aliases'. + +If OBJECT is not a symbol, just return it. If there is a loop in the +chain of aliases, signal a `cyclic-variable-indirection' error. */) (Lisp_Object object) { if (SYMBOLP (object)) @@ -1006,7 +1008,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ XSETSYMBOL (var, symbol); if (blv->frame_local) { - tem1 = assq_no_quit (var, FVAR (XFRAME (selected_frame), param_alist)); + tem1 = assq_no_quit (var, XFRAME (selected_frame)->param_alist); blv->where = selected_frame; } else @@ -1179,7 +1181,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register XSETSYMBOL (symbol, sym); /* May have changed via aliasing. */ tem1 = Fassq (symbol, (blv->frame_local - ? FVAR (XFRAME (where), param_alist) + ? XFRAME (where)->param_alist : BVAR (XBUFFER (where), local_var_alist))); blv->where = where; blv->found = 1; @@ -1211,8 +1213,8 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register bindings, not for frame-local bindings. */ eassert (!blv->frame_local); tem1 = Fcons (symbol, XCDR (blv->defcell)); - BVAR (XBUFFER (where), local_var_alist) - = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); + BSET (XBUFFER (where), local_var_alist, + Fcons (tem1, BVAR (XBUFFER (where), local_var_alist))); } } @@ -1651,9 +1653,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default value. */ find_symbol_value (variable); - BVAR (current_buffer, local_var_alist) - = Fcons (Fcons (variable, XCDR (blv->defcell)), - BVAR (current_buffer, local_var_alist)); + BSET (current_buffer, local_var_alist, + Fcons (Fcons (variable, XCDR (blv->defcell)), + BVAR (current_buffer, local_var_alist))); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value. */ @@ -1721,8 +1723,8 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - BVAR (current_buffer, local_var_alist) - = Fdelq (tem, BVAR (current_buffer, local_var_alist)); + BSET (current_buffer, local_var_alist, + Fdelq (tem, BVAR (current_buffer, local_var_alist))); /* If the symbol is set up with the current buffer's binding loaded, recompute its value. We have to do it now, or else @@ -2019,12 +2021,12 @@ indirect_function (register Lisp_Object object) { if (!SYMBOLP (hare) || EQ (hare, Qunbound)) break; - hare = SVAR (XSYMBOL (hare), function); + hare = XSYMBOL (hare)->function; if (!SYMBOLP (hare) || EQ (hare, Qunbound)) break; - hare = SVAR (XSYMBOL (hare), function); + hare = XSYMBOL (hare)->function; - tortoise = SVAR (XSYMBOL (tortoise), function); + tortoise = XSYMBOL (tortoise)->function; if (EQ (hare, tortoise)) xsignal1 (Qcyclic_function_indirection, object); @@ -2048,7 +2050,7 @@ function chain of symbols. */) /* Optimize for no indirection. */ result = object; if (SYMBOLP (result) && !EQ (result, Qunbound) - && (result = SVAR (XSYMBOL (result), function), SYMBOLP (result))) + && (result = XSYMBOL (result)->function, SYMBOLP (result))) result = indirect_function (result); if (!EQ (result, Qunbound)) return result; @@ -2179,10 +2181,9 @@ bool-vector. IDX starts at 0. */) { /* We must relocate the string data. */ ptrdiff_t nchars = SCHARS (array); - unsigned char *str; USE_SAFE_ALLOCA; + unsigned char *str = SAFE_ALLOCA (nbytes); - SAFE_ALLOCA (str, unsigned char *, nbytes); memcpy (str, SDATA (array), nbytes); allocate_string_data (XSTRING (array), nchars, nbytes + new_bytes - prev_bytes); @@ -3197,7 +3198,7 @@ syms_of_data (void) defsubr (&Ssubr_arity); defsubr (&Ssubr_name); - SVAR (XSYMBOL (Qwholenump), function) = SVAR (XSYMBOL (Qnatnump), function); + set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function); DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. */); diff --git a/src/dired.c b/src/dired.c index 7c047f97e6f..771230717e3 100644 --- a/src/dired.c +++ b/src/dired.c @@ -810,9 +810,8 @@ file_name_completion_stat (Lisp_Object dirname, DIRENTRY *dp, struct stat *st_ad ptrdiff_t len = NAMLEN (dp); ptrdiff_t pos = SCHARS (dirname); int value; - char *fullname; USE_SAFE_ALLOCA; - SAFE_ALLOCA (fullname, char *, len + pos + 2); + char *fullname = SAFE_ALLOCA (len + pos + 2); #ifdef MSDOS /* Some fields of struct stat are *very* expensive to compute on MS-DOS, diff --git a/src/dispextern.h b/src/dispextern.h index fac997077c2..7e13db58073 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -46,8 +46,13 @@ typedef struct { #include "msdos.h" #endif +INLINE_HEADER_BEGIN +#ifndef DISPEXTERN_INLINE +# define DISPEXTERN_INLINE INLINE +#endif + #include -static inline int +DISPEXTERN_INLINE int xstrcasecmp (char const *a, char const *b) { return c_strcasecmp (a, b); @@ -1384,7 +1389,7 @@ struct glyph_string ? current_mode_line_height \ : (MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ ? MATRIX_MODE_LINE_HEIGHT ((W)->current_matrix) \ - : estimate_mode_line_height (XFRAME (WVAR (W, frame)), \ + : estimate_mode_line_height (XFRAME (W->frame), \ CURRENT_MODE_LINE_FACE_ID (W)))) /* Return the current height of the header line of window W. If not @@ -1397,7 +1402,7 @@ struct glyph_string ? current_header_line_height \ : (MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ ? MATRIX_HEADER_LINE_HEIGHT ((W)->current_matrix) \ - : estimate_mode_line_height (XFRAME (WVAR (W, frame)),\ + : estimate_mode_line_height (XFRAME (W->frame),\ HEADER_LINE_FACE_ID))) /* Return the height of the desired mode line of window W. */ @@ -1416,8 +1421,8 @@ struct glyph_string (!MINI_WINDOW_P ((W)) \ && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ - && BUFFERP (WVAR (W, buffer)) \ - && !NILP (BVAR (XBUFFER (WVAR (W, buffer)), mode_line_format)) \ + && BUFFERP (W->buffer) \ + && !NILP (BVAR (XBUFFER (W->buffer), mode_line_format)) \ && WINDOW_TOTAL_LINES (W) > 1) /* Value is non-zero if window W wants a header line. */ @@ -1426,10 +1431,10 @@ struct glyph_string (!MINI_WINDOW_P ((W)) \ && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ - && BUFFERP (WVAR (W, buffer)) \ - && !NILP (BVAR (XBUFFER (WVAR (W, buffer)), header_line_format)) \ + && BUFFERP (W->buffer) \ + && !NILP (BVAR (XBUFFER (W->buffer), header_line_format)) \ && WINDOW_TOTAL_LINES (W) > 1 \ - + !NILP (BVAR (XBUFFER (WVAR (W, buffer)), mode_line_format))) + + !NILP (BVAR (XBUFFER (W->buffer), mode_line_format))) /* Return proper value to be used as baseline offset of font that has @@ -3428,4 +3433,6 @@ extern Lisp_Object x_default_parameter (struct frame *, Lisp_Object, #endif /* HAVE_WINDOW_SYSTEM */ +INLINE_HEADER_END + #endif /* not DISPEXTERN_H_INCLUDED */ diff --git a/src/dispnew.c b/src/dispnew.c index fc981eaa7c1..506e174850e 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -17,6 +17,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ #include + +#define DISPEXTERN_INLINE EXTERN_INLINE + #include #include #include @@ -67,33 +70,10 @@ along with GNU Emacs. If not, see . */ #include "systime.h" #include -/* Get number of chars of output now in the buffer of a stdio stream. - This ought to be built in stdio, but it isn't. Some s- files - override this because their stdio internals differ. */ -#ifdef __GNU_LIBRARY__ - -/* The s- file might have overridden the definition with one that - works for the system's C library. But we are using the GNU C - library, so this is the right definition for every system. */ -#ifdef GNU_LIBRARY_PENDING_OUTPUT_COUNT -#define PENDING_OUTPUT_COUNT GNU_LIBRARY_PENDING_OUTPUT_COUNT -#else -#undef PENDING_OUTPUT_COUNT -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__bufp - (FILE)->__buffer) -#endif - -/* not __GNU_LIBRARY__ and no PENDING_OUTPUT_COUNT defined */ -#elif !defined (PENDING_OUTPUT_COUNT) - -#if HAVE_STDIO_EXT_H && HAVE___FPENDING +#ifdef DISPNEW_NEEDS_STDIO_EXT #include -#define PENDING_OUTPUT_COUNT(FILE) __fpending (FILE) -#else -#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base) #endif -#endif /* not __GNU_LIBRARY__ and no PENDING_OUTPUT_COUNT defined */ - #if defined (HAVE_TERM_H) && defined (GNU_LINUX) #include /* for tgetent */ #endif @@ -270,9 +250,9 @@ add_window_display_history (struct window *w, const char *msg, int paused_p) "%"pMu": window %p (`%s')%s\n%s", history_tick++, w, - ((BUFFERP (WVAR (w, buffer)) - && STRINGP (BVAR (XBUFFER (WVAR (w, buffer)), name))) - ? SSDATA (BVAR (XBUFFER (WVAR (w, buffer)), name)) + ((BUFFERP (w->buffer) + && STRINGP (BVAR (XBUFFER (w->buffer), name))) + ? SSDATA (BVAR (XBUFFER (w->buffer), name)) : "???"), paused_p ? " ***paused***" : "", msg); @@ -409,7 +389,7 @@ margin_glyphs_to_reserve (struct window *w, int total_glyphs, Lisp_Object margin if (NUMBERP (margin)) { - int width = XFASTINT (WVAR (w, total_cols)); + int width = XFASTINT (w->total_cols); double d = max (0, XFLOATINT (margin)); d = min (width / 2 - 1, d); n = (int) ((double) total_glyphs / width * d); @@ -479,8 +459,8 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y the matrix means preventing redisplay. */ if (matrix->pool == NULL) { - left = margin_glyphs_to_reserve (w, dim.width, WVAR (w, left_margin_cols)); - right = margin_glyphs_to_reserve (w, dim.width, WVAR (w, right_margin_cols)); + left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols); + right = margin_glyphs_to_reserve (w, dim.width, w->right_margin_cols); eassert (left >= 0 && right >= 0); marginal_areas_changed_p = (left != matrix->left_margin_glyphs || right != matrix->right_margin_glyphs); @@ -519,9 +499,9 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y if (w) { left = margin_glyphs_to_reserve (w, dim.width, - WVAR (w, left_margin_cols)); + w->left_margin_cols); right = margin_glyphs_to_reserve (w, dim.width, - WVAR (w, right_margin_cols)); + w->right_margin_cols); } else left = right = 0; @@ -644,9 +624,9 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y /* Window end is invalid, if inside of the rows that are invalidated below. */ - if (INTEGERP (WVAR (w, window_end_vpos)) - && XFASTINT (WVAR (w, window_end_vpos)) >= i) - WVAR (w, window_end_valid) = Qnil; + if (INTEGERP (w->window_end_vpos) + && XFASTINT (w->window_end_vpos) >= i) + WSET (w, window_end_valid, Qnil); while (i < matrix->nrows) matrix->rows[i++].enabled_p = 0; @@ -845,12 +825,12 @@ clear_current_matrices (register struct frame *f) /* Clear the matrix of the menu bar window, if such a window exists. The menu bar window is currently used to display menus on X when no toolkit support is compiled in. */ - if (WINDOWP (FVAR (f, menu_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, menu_bar_window))->current_matrix); + if (WINDOWP (f->menu_bar_window)) + clear_glyph_matrix (XWINDOW (f->menu_bar_window)->current_matrix); /* Clear the matrix of the tool-bar window, if any. */ - if (WINDOWP (FVAR (f, tool_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, tool_bar_window))->current_matrix); + if (WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); /* Clear current window matrices. */ eassert (WINDOWP (FRAME_ROOT_WINDOW (f))); @@ -866,11 +846,11 @@ clear_desired_matrices (register struct frame *f) if (f->desired_matrix) clear_glyph_matrix (f->desired_matrix); - if (WINDOWP (FVAR (f, menu_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, menu_bar_window))->desired_matrix); + if (WINDOWP (f->menu_bar_window)) + clear_glyph_matrix (XWINDOW (f->menu_bar_window)->desired_matrix); - if (WINDOWP (FVAR (f, tool_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, tool_bar_window))->desired_matrix); + if (WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->desired_matrix); /* Do it for window matrices. */ eassert (WINDOWP (FRAME_ROOT_WINDOW (f))); @@ -886,15 +866,15 @@ clear_window_matrices (struct window *w, int desired_p) { while (w) { - if (!NILP (WVAR (w, hchild))) + if (!NILP (w->hchild)) { - eassert (WINDOWP (WVAR (w, hchild))); - clear_window_matrices (XWINDOW (WVAR (w, hchild)), desired_p); + eassert (WINDOWP (w->hchild)); + clear_window_matrices (XWINDOW (w->hchild), desired_p); } - else if (!NILP (WVAR (w, vchild))) + else if (!NILP (w->vchild)) { - eassert (WINDOWP (WVAR (w, vchild))); - clear_window_matrices (XWINDOW (WVAR (w, vchild)), desired_p); + eassert (WINDOWP (w->vchild)); + clear_window_matrices (XWINDOW (w->vchild), desired_p); } else { @@ -903,11 +883,11 @@ clear_window_matrices (struct window *w, int desired_p) else { clear_glyph_matrix (w->current_matrix); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); } } - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -971,7 +951,7 @@ blank_row (struct window *w, struct glyph_row *row, int y) clear_glyph_row (row); row->y = y; row->ascent = row->phys_ascent = 0; - row->height = row->phys_height = FRAME_LINE_HEIGHT (XFRAME (WVAR (w, frame))); + row->height = row->phys_height = FRAME_LINE_HEIGHT (XFRAME (w->frame)); row->visible_height = row->height; if (row->y < min_y) @@ -1517,7 +1497,7 @@ check_matrix_invariants (struct window *w) struct glyph_row *row = matrix->rows; struct glyph_row *last_text_row = NULL; struct buffer *saved = current_buffer; - struct buffer *buffer = XBUFFER (WVAR (w, buffer)); + struct buffer *buffer = XBUFFER (w->buffer); int c; /* This can sometimes happen for a fresh window. */ @@ -1680,8 +1660,8 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y, points to the mini-buffer window, if any, which is arranged vertically below other windows. */ in_horz_combination_p - = (!NILP (WVAR (XWINDOW (window), parent)) - && !NILP (WVAR (XWINDOW (WVAR (XWINDOW (window), parent)), hchild))); + = (!NILP (XWINDOW (window)->parent) + && !NILP (XWINDOW (XWINDOW (window)->parent)->hchild)); /* For WINDOW and all windows on the same level. */ do @@ -1690,12 +1670,12 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y, /* Get the dimension of the window sub-matrix for W, depending on whether this is a combination or a leaf window. */ - if (!NILP (WVAR (w, hchild))) - dim = allocate_matrices_for_frame_redisplay (WVAR (w, hchild), x, y, + if (!NILP (w->hchild)) + dim = allocate_matrices_for_frame_redisplay (w->hchild, x, y, dim_only_p, window_change_flags); - else if (!NILP (WVAR (w, vchild))) - dim = allocate_matrices_for_frame_redisplay (WVAR (w, vchild), x, y, + else if (!NILP (w->vchild)) + dim = allocate_matrices_for_frame_redisplay (w->vchild, x, y, dim_only_p, window_change_flags); else @@ -1719,10 +1699,10 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y, || dim.width != w->desired_matrix->matrix_w || dim.height != w->desired_matrix->matrix_h || (margin_glyphs_to_reserve (w, dim.width, - WVAR (w, left_margin_cols)) + w->left_margin_cols) != w->desired_matrix->left_margin_glyphs) || (margin_glyphs_to_reserve (w, dim.width, - WVAR (w, right_margin_cols)) + w->right_margin_cols) != w->desired_matrix->right_margin_glyphs)) *window_change_flags |= CHANGED_LEAF_MATRIX; @@ -1751,7 +1731,7 @@ allocate_matrices_for_frame_redisplay (Lisp_Object window, int x, int y, hmax = max (hmax, dim.height); /* Next window on same level. */ - window = WVAR (w, next); + window = w->next; } while (!NILP (window)); @@ -1782,7 +1762,7 @@ static int required_matrix_height (struct window *w) { #ifdef HAVE_WINDOW_SYSTEM - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); if (FRAME_WINDOW_P (f)) { @@ -1808,7 +1788,7 @@ static int required_matrix_width (struct window *w) { #ifdef HAVE_WINDOW_SYSTEM - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); if (FRAME_WINDOW_P (f)) { int ch_width = FRAME_SMALLEST_CHAR_WIDTH (f); @@ -1825,7 +1805,7 @@ required_matrix_width (struct window *w) } #endif /* HAVE_WINDOW_SYSTEM */ - return XINT (WVAR (w, total_cols)); + return XINT (w->total_cols); } @@ -1837,10 +1817,10 @@ allocate_matrices_for_window_redisplay (struct window *w) { while (w) { - if (!NILP (WVAR (w, vchild))) - allocate_matrices_for_window_redisplay (XWINDOW (WVAR (w, vchild))); - else if (!NILP (WVAR (w, hchild))) - allocate_matrices_for_window_redisplay (XWINDOW (WVAR (w, hchild))); + if (!NILP (w->vchild)) + allocate_matrices_for_window_redisplay (XWINDOW (w->vchild)); + else if (!NILP (w->hchild)) + allocate_matrices_for_window_redisplay (XWINDOW (w->hchild)); else { /* W is a leaf window. */ @@ -1859,7 +1839,7 @@ allocate_matrices_for_window_redisplay (struct window *w) adjust_glyph_matrix (w, w->current_matrix, 0, 0, dim); } - w = NILP (WVAR (w, next)) ? NULL : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? NULL : XWINDOW (w->next); } } @@ -1905,21 +1885,21 @@ static void adjust_frame_glyphs_initially (void) { struct frame *sf = SELECTED_FRAME (); - struct window *root = XWINDOW (FVAR (sf, root_window)); - struct window *mini = XWINDOW (WVAR (root, next)); + struct window *root = XWINDOW (sf->root_window); + struct window *mini = XWINDOW (root->next); int frame_lines = FRAME_LINES (sf); int frame_cols = FRAME_COLS (sf); int top_margin = FRAME_TOP_MARGIN (sf); /* Do it for the root window. */ - XSETFASTINT (WVAR (root, top_line), top_margin); - XSETFASTINT (WVAR (root, total_lines), frame_lines - 1 - top_margin); - XSETFASTINT (WVAR (root, total_cols), frame_cols); + WSET (root, top_line, make_number (top_margin)); + WSET (root, total_lines, make_number (frame_lines - 1 - top_margin)); + WSET (root, total_cols, make_number (frame_cols)); /* Do it for the mini-buffer window. */ - XSETFASTINT (WVAR (mini, top_line), frame_lines - 1); - XSETFASTINT (WVAR (mini, total_lines), 1); - XSETFASTINT (WVAR (mini, total_cols), frame_cols); + WSET (mini, top_line, make_number (frame_lines - 1)); + WSET (mini, total_lines, make_number (1)); + WSET (mini, total_cols, make_number (frame_cols)); adjust_frame_glyphs (sf); glyphs_initialized_initially_p = 1; @@ -1951,21 +1931,21 @@ showing_window_margins_p (struct window *w) { while (w) { - if (!NILP (WVAR (w, hchild))) + if (!NILP (w->hchild)) { - if (showing_window_margins_p (XWINDOW (WVAR (w, hchild)))) + if (showing_window_margins_p (XWINDOW (w->hchild))) return 1; } - else if (!NILP (WVAR (w, vchild))) + else if (!NILP (w->vchild)) { - if (showing_window_margins_p (XWINDOW (WVAR (w, vchild)))) + if (showing_window_margins_p (XWINDOW (w->vchild))) return 1; } - else if (!NILP (WVAR (w, left_margin_cols)) - || !NILP (WVAR (w, right_margin_cols))) + else if (!NILP (w->left_margin_cols) + || !NILP (w->right_margin_cols)) return 1; - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } return 0; } @@ -1979,18 +1959,18 @@ fake_current_matrices (Lisp_Object window) { struct window *w; - for (; !NILP (window); window = WVAR (w, next)) + for (; !NILP (window); window = w->next) { w = XWINDOW (window); - if (!NILP (WVAR (w, hchild))) - fake_current_matrices (WVAR (w, hchild)); - else if (!NILP (WVAR (w, vchild))) - fake_current_matrices (WVAR (w, vchild)); + if (!NILP (w->hchild)) + fake_current_matrices (w->hchild); + else if (!NILP (w->vchild)) + fake_current_matrices (w->vchild); else { int i; - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph_matrix *m = w->current_matrix; struct glyph_matrix *fm = f->current_matrix; @@ -2188,22 +2168,24 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f) { /* Allocate a dummy window if not already done. */ struct window *w; - if (NILP (FVAR (f, menu_bar_window))) + if (NILP (f->menu_bar_window)) { - FVAR (f, menu_bar_window) = make_window (); - w = XWINDOW (FVAR (f, menu_bar_window)); - XSETFRAME (WVAR (w, frame), f); + Lisp_Object frame; + FSET (f, menu_bar_window, make_window ()); + w = XWINDOW (f->menu_bar_window); + XSETFRAME (frame, f); + WSET (w, frame, frame); w->pseudo_window_p = 1; } else - w = XWINDOW (FVAR (f, menu_bar_window)); + w = XWINDOW (f->menu_bar_window); /* Set window dimensions to frame dimensions and allocate or adjust glyph matrices of W. */ - XSETFASTINT (WVAR (w, top_line), 0); - XSETFASTINT (WVAR (w, left_col), 0); - XSETFASTINT (WVAR (w, total_lines), FRAME_MENU_BAR_LINES (f)); - XSETFASTINT (WVAR (w, total_cols), FRAME_TOTAL_COLS (f)); + WSET (w, top_line, make_number (0)); + WSET (w, left_col, make_number (0)); + WSET (w, total_lines, make_number (FRAME_MENU_BAR_LINES (f))); + WSET (w, total_cols, make_number (FRAME_TOTAL_COLS (f))); allocate_matrices_for_window_redisplay (w); } #endif /* not USE_X_TOOLKIT && not USE_GTK */ @@ -2214,20 +2196,22 @@ adjust_frame_glyphs_for_window_redisplay (struct frame *f) /* Allocate/ reallocate matrices of the tool bar window. If we don't have a tool bar window yet, make one. */ struct window *w; - if (NILP (FVAR (f, tool_bar_window))) + if (NILP (f->tool_bar_window)) { - FVAR (f, tool_bar_window) = make_window (); - w = XWINDOW (FVAR (f, tool_bar_window)); - XSETFRAME (WVAR (w, frame), f); + Lisp_Object frame; + FSET (f, tool_bar_window, make_window ()); + w = XWINDOW (f->tool_bar_window); + XSETFRAME (frame, f); + WSET (w, frame, frame); w->pseudo_window_p = 1; } else - w = XWINDOW (FVAR (f, tool_bar_window)); + w = XWINDOW (f->tool_bar_window); - XSETFASTINT (WVAR (w, top_line), FRAME_MENU_BAR_LINES (f)); - XSETFASTINT (WVAR (w, left_col), 0); - XSETFASTINT (WVAR (w, total_lines), FRAME_TOOL_BAR_LINES (f)); - XSETFASTINT (WVAR (w, total_cols), FRAME_TOTAL_COLS (f)); + WSET (w, top_line, make_number (FRAME_MENU_BAR_LINES (f))); + WSET (w, left_col, make_number (0)); + WSET (w, total_lines, make_number (FRAME_TOOL_BAR_LINES (f))); + WSET (w, total_cols, make_number (FRAME_TOTAL_COLS (f))); allocate_matrices_for_window_redisplay (w); } #endif @@ -2282,28 +2266,28 @@ free_glyphs (struct frame *f) f->glyphs_initialized_p = 0; /* Release window sub-matrices. */ - if (!NILP (FVAR (f, root_window))) - free_window_matrices (XWINDOW (FVAR (f, root_window))); + if (!NILP (f->root_window)) + free_window_matrices (XWINDOW (f->root_window)); /* Free the dummy window for menu bars without X toolkit and its glyph matrices. */ - if (!NILP (FVAR (f, menu_bar_window))) + if (!NILP (f->menu_bar_window)) { - struct window *w = XWINDOW (FVAR (f, menu_bar_window)); + struct window *w = XWINDOW (f->menu_bar_window); free_glyph_matrix (w->desired_matrix); free_glyph_matrix (w->current_matrix); w->desired_matrix = w->current_matrix = NULL; - FVAR (f, menu_bar_window) = Qnil; + FSET (f, menu_bar_window, Qnil); } /* Free the tool bar window and its glyph matrices. */ - if (!NILP (FVAR (f, tool_bar_window))) + if (!NILP (f->tool_bar_window)) { - struct window *w = XWINDOW (FVAR (f, tool_bar_window)); + struct window *w = XWINDOW (f->tool_bar_window); free_glyph_matrix (w->desired_matrix); free_glyph_matrix (w->current_matrix); w->desired_matrix = w->current_matrix = NULL; - FVAR (f, tool_bar_window) = Qnil; + FSET (f, tool_bar_window, Qnil); } /* Release frame glyph matrices. Reset fields to zero in @@ -2337,10 +2321,10 @@ free_window_matrices (struct window *w) { while (w) { - if (!NILP (WVAR (w, hchild))) - free_window_matrices (XWINDOW (WVAR (w, hchild))); - else if (!NILP (WVAR (w, vchild))) - free_window_matrices (XWINDOW (WVAR (w, vchild))); + if (!NILP (w->hchild)) + free_window_matrices (XWINDOW (w->hchild)); + else if (!NILP (w->vchild)) + free_window_matrices (XWINDOW (w->vchild)); else { /* This is a leaf window. Free its memory and reset fields @@ -2352,7 +2336,7 @@ free_window_matrices (struct window *w) } /* Next window on same level. */ - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -2473,14 +2457,14 @@ build_frame_matrix_from_window_tree (struct glyph_matrix *matrix, struct window { while (w) { - if (!NILP (WVAR (w, hchild))) - build_frame_matrix_from_window_tree (matrix, XWINDOW (WVAR (w, hchild))); - else if (!NILP (WVAR (w, vchild))) - build_frame_matrix_from_window_tree (matrix, XWINDOW (WVAR (w, vchild))); + if (!NILP (w->hchild)) + build_frame_matrix_from_window_tree (matrix, XWINDOW (w->hchild)); + else if (!NILP (w->vchild)) + build_frame_matrix_from_window_tree (matrix, XWINDOW (w->vchild)); else build_frame_matrix_from_leaf_window (matrix, w); - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -2619,7 +2603,7 @@ spec_glyph_lookup_face (struct window *w, GLYPH *glyph) /* Convert the glyph's specified face to a realized (cache) face. */ if (lface_id > 0) { - int face_id = merge_faces (XFRAME (WVAR (w, frame)), + int face_id = merge_faces (XFRAME (w->frame), Qt, lface_id, DEFAULT_FACE_ID); SET_GLYPH_FACE (*glyph, face_id); } @@ -2726,7 +2710,7 @@ make_current (struct glyph_matrix *desired_matrix, struct glyph_matrix *current_ /* If we are called on frame matrices, perform analogous operations for window matrices. */ if (frame_matrix_frame) - mirror_make_current (XWINDOW (FVAR (frame_matrix_frame, root_window)), row); + mirror_make_current (XWINDOW (frame_matrix_frame->root_window), row); } @@ -2740,10 +2724,10 @@ mirror_make_current (struct window *w, int frame_row) { while (w) { - if (!NILP (WVAR (w, hchild))) - mirror_make_current (XWINDOW (WVAR (w, hchild)), frame_row); - else if (!NILP (WVAR (w, vchild))) - mirror_make_current (XWINDOW (WVAR (w, vchild)), frame_row); + if (!NILP (w->hchild)) + mirror_make_current (XWINDOW (w->hchild), frame_row); + else if (!NILP (w->vchild)) + mirror_make_current (XWINDOW (w->vchild), frame_row); else { /* Row relative to window W. Don't use FRAME_TO_WINDOW_VPOS @@ -2776,7 +2760,7 @@ mirror_make_current (struct window *w, int frame_row) } } - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -2824,7 +2808,7 @@ mirrored_line_dance (struct glyph_matrix *matrix, int unchanged_at_top, int nlin /* Do the same for window matrices, if MATRIX is a frame matrix. */ if (frame_matrix_frame) - mirror_line_dance (XWINDOW (FVAR (frame_matrix_frame, root_window)), + mirror_line_dance (XWINDOW (frame_matrix_frame->root_window), unchanged_at_top, nlines, copy_from, retained_p); } @@ -2835,16 +2819,16 @@ mirrored_line_dance (struct glyph_matrix *matrix, int unchanged_at_top, int nlin static void sync_window_with_frame_matrix_rows (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph_row *window_row, *window_row_end, *frame_row; int left, right, x, width; /* Preconditions: W must be a leaf window on a tty frame. */ - eassert (NILP (WVAR (w, hchild)) && NILP (WVAR (w, vchild))); + eassert (NILP (w->hchild) && NILP (w->vchild)); eassert (!FRAME_WINDOW_P (f)); - left = margin_glyphs_to_reserve (w, 1, WVAR (w, left_margin_cols)); - right = margin_glyphs_to_reserve (w, 1, WVAR (w, right_margin_cols)); + left = margin_glyphs_to_reserve (w, 1, w->left_margin_cols); + right = margin_glyphs_to_reserve (w, 1, w->right_margin_cols); x = w->current_matrix->matrix_x; width = w->current_matrix->matrix_w; @@ -2876,15 +2860,15 @@ frame_row_to_window (struct window *w, int row) while (w && !found) { - if (!NILP (WVAR (w, hchild))) - found = frame_row_to_window (XWINDOW (WVAR (w, hchild)), row); - else if (!NILP (WVAR (w, vchild))) - found = frame_row_to_window (XWINDOW (WVAR (w, vchild)), row); + if (!NILP (w->hchild)) + found = frame_row_to_window (XWINDOW (w->hchild), row); + else if (!NILP (w->vchild)) + found = frame_row_to_window (XWINDOW (w->vchild), row); else if (row >= WINDOW_TOP_EDGE_LINE (w) && row < WINDOW_BOTTOM_EDGE_LINE (w)) found = w; - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } return found; @@ -2907,11 +2891,11 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy { while (w) { - if (!NILP (WVAR (w, hchild))) - mirror_line_dance (XWINDOW (WVAR (w, hchild)), unchanged_at_top, + if (!NILP (w->hchild)) + mirror_line_dance (XWINDOW (w->hchild), unchanged_at_top, nlines, copy_from, retained_p); - else if (!NILP (WVAR (w, vchild))) - mirror_line_dance (XWINDOW (WVAR (w, vchild)), unchanged_at_top, + else if (!NILP (w->vchild)) + mirror_line_dance (XWINDOW (w->vchild), unchanged_at_top, nlines, copy_from, retained_p); else { @@ -2967,7 +2951,7 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy { /* A copy between windows. This is an infrequent case not worth optimizing. */ - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct window *root = XWINDOW (FRAME_ROOT_WINDOW (f)); struct window *w2; struct glyph_matrix *m2; @@ -3004,7 +2988,7 @@ mirror_line_dance (struct window *w, int unchanged_at_top, int nlines, int *copy } /* Next window on same level. */ - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -3022,18 +3006,18 @@ check_window_matrix_pointers (struct window *w) { while (w) { - if (!NILP (WVAR (w, hchild))) - check_window_matrix_pointers (XWINDOW (WVAR (w, hchild))); - else if (!NILP (WVAR (w, vchild))) - check_window_matrix_pointers (XWINDOW (WVAR (w, vchild))); + if (!NILP (w->hchild)) + check_window_matrix_pointers (XWINDOW (w->hchild)); + else if (!NILP (w->vchild)) + check_window_matrix_pointers (XWINDOW (w->vchild)); else { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); check_matrix_pointers (w->desired_matrix, f->desired_matrix); check_matrix_pointers (w->current_matrix, f->current_matrix); } - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -3081,10 +3065,10 @@ check_matrix_pointers (struct glyph_matrix *window_matrix, static int window_to_frame_vpos (struct window *w, int vpos) { - eassert (!FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))); + eassert (!FRAME_WINDOW_P (XFRAME (w->frame))); eassert (vpos >= 0 && vpos <= w->desired_matrix->nrows); vpos += WINDOW_TOP_EDGE_LINE (w); - eassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (WVAR (w, frame)))); + eassert (vpos >= 0 && vpos <= FRAME_LINES (XFRAME (w->frame))); return vpos; } @@ -3095,7 +3079,7 @@ window_to_frame_vpos (struct window *w, int vpos) static int window_to_frame_hpos (struct window *w, int hpos) { - eassert (!FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))); + eassert (!FRAME_WINDOW_P (XFRAME (w->frame))); hpos += WINDOW_LEFT_EDGE_COL (w); return hpos; } @@ -3187,7 +3171,7 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p) { /* 1 means display has been paused because of pending input. */ int paused_p; - struct window *root_window = XWINDOW (FVAR (f, root_window)); + struct window *root_window = XWINDOW (f->root_window); if (redisplay_dont_pause) force_p = 1; @@ -3222,13 +3206,13 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p) /* Update the menu bar on X frames that don't have toolkit support. */ - if (WINDOWP (FVAR (f, menu_bar_window))) - update_window (XWINDOW (FVAR (f, menu_bar_window)), 1); + if (WINDOWP (f->menu_bar_window)) + update_window (XWINDOW (f->menu_bar_window), 1); /* Update the tool-bar window, if present. */ - if (WINDOWP (FVAR (f, tool_bar_window))) + if (WINDOWP (f->tool_bar_window)) { - struct window *w = XWINDOW (FVAR (f, tool_bar_window)); + struct window *w = XWINDOW (f->tool_bar_window); /* Update tool-bar window. */ if (w->must_be_updated_p) @@ -3240,10 +3224,9 @@ update_frame (struct frame *f, int force_p, int inhibit_hairy_id_p) /* Swap tool-bar strings. We swap because we want to reuse strings. */ - tem = FVAR (f, current_tool_bar_string); - FVAR (f, current_tool_bar_string) = FVAR (f, - desired_tool_bar_string); - FVAR (f, desired_tool_bar_string) = tem; + tem = f->current_tool_bar_string; + FSET (f, current_tool_bar_string, f->desired_tool_bar_string); + FSET (f, desired_tool_bar_string, tem); } } @@ -3315,14 +3298,14 @@ update_window_tree (struct window *w, int force_p) while (w && !paused_p) { - if (!NILP (WVAR (w, hchild))) - paused_p |= update_window_tree (XWINDOW (WVAR (w, hchild)), force_p); - else if (!NILP (WVAR (w, vchild))) - paused_p |= update_window_tree (XWINDOW (WVAR (w, vchild)), force_p); + if (!NILP (w->hchild)) + paused_p |= update_window_tree (XWINDOW (w->hchild), force_p); + else if (!NILP (w->vchild)) + paused_p |= update_window_tree (XWINDOW (w->vchild), force_p); else if (w->must_be_updated_p) paused_p |= update_window (w, force_p); - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } return paused_p; @@ -3813,7 +3796,7 @@ update_text_area (struct window *w, int vpos) struct glyph *glyph = ¤t_row->glyphs[TEXT_AREA][i - 1]; int left, right; - rif->get_glyph_overhangs (glyph, XFRAME (WVAR (w, frame)), + rif->get_glyph_overhangs (glyph, XFRAME (w->frame), &left, &right); can_skip_p = (right == 0 && !abort_skipping); } @@ -3846,7 +3829,7 @@ update_text_area (struct window *w, int vpos) int left, right; rif->get_glyph_overhangs (current_glyph, - XFRAME (WVAR (w, frame)), + XFRAME (w->frame), &left, &right); while (left > 0 && i > 0) { @@ -3989,7 +3972,7 @@ update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p) /* Update display of the left margin area, if there is one. */ if (!desired_row->full_width_p - && !NILP (WVAR (w, left_margin_cols))) + && !NILP (w->left_margin_cols)) { changed_p = 1; update_marginal_area (w, LEFT_MARGIN_AREA, vpos); @@ -4005,7 +3988,7 @@ update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p) /* Update display of the right margin area, if there is one. */ if (!desired_row->full_width_p - && !NILP (WVAR (w, right_margin_cols))) + && !NILP (w->right_margin_cols)) { changed_p = 1; update_marginal_area (w, RIGHT_MARGIN_AREA, vpos); @@ -4038,7 +4021,7 @@ update_window_line (struct window *w, int vpos, int *mouse_face_overwritten_p) static void set_window_cursor_after_update (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct redisplay_interface *rif = FRAME_RIF (f); int cx, cy, vpos, hpos; @@ -4124,14 +4107,14 @@ set_window_update_flags (struct window *w, int on_p) { while (w) { - if (!NILP (WVAR (w, hchild))) - set_window_update_flags (XWINDOW (WVAR (w, hchild)), on_p); - else if (!NILP (WVAR (w, vchild))) - set_window_update_flags (XWINDOW (WVAR (w, vchild)), on_p); + if (!NILP (w->hchild)) + set_window_update_flags (XWINDOW (w->hchild), on_p); + else if (!NILP (w->vchild)) + set_window_update_flags (XWINDOW (w->vchild), on_p); else w->must_be_updated_p = on_p; - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -4820,8 +4803,8 @@ update_frame_1 (struct frame *f, int force_p, int inhibit_id_p) int x = WINDOW_TO_FRAME_HPOS (w, w->cursor.hpos); int y = WINDOW_TO_FRAME_VPOS (w, w->cursor.vpos); - if (INTEGERP (WVAR (w, left_margin_cols))) - x += XFASTINT (WVAR (w, left_margin_cols)); + if (INTEGERP (w->left_margin_cols)) + x += XFASTINT (w->left_margin_cols); /* x = max (min (x, FRAME_TOTAL_COLS (f) - 1), 0); */ cursor_to (f, y, x); @@ -5311,9 +5294,9 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p /* We used to set current_buffer directly here, but that does the wrong thing with `face-remapping-alist' (bug#2044). */ - Fset_buffer (WVAR (w, buffer)); + Fset_buffer (w->buffer); itdata = bidi_shelve_cache (); - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); CHARPOS (startp) = min (ZV, max (BEGV, CHARPOS (startp))); BYTEPOS (startp) = min (ZV_BYTE, max (BEGV_BYTE, BYTEPOS (startp))); start_display (&it, w, startp); @@ -5357,7 +5340,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p *dx = x0 + it.first_visible_x - it.current_x; *dy = *y - it.current_y; - string = WVAR (w, buffer); + string = w->buffer; if (STRINGP (it.string)) string = it.string; *pos = it.current; @@ -5375,7 +5358,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p if (STRINGP (it.string)) BYTEPOS (pos->pos) = string_char_to_byte (string, CHARPOS (pos->pos)); else - BYTEPOS (pos->pos) = buf_charpos_to_bytepos (XBUFFER (WVAR (w, buffer)), + BYTEPOS (pos->pos) = buf_charpos_to_bytepos (XBUFFER (w->buffer), CHARPOS (pos->pos)); } @@ -5774,8 +5757,8 @@ change_frame_size_1 (register struct frame *f, int newheight, int newwidth, int if ((FRAME_TERMCAP_P (f) && !pretend) || FRAME_MSDOS_P (f)) FrameCols (FRAME_TTY (f)) = newwidth; - if (WINDOWP (FVAR (f, tool_bar_window))) - XSETFASTINT (WVAR (XWINDOW (FVAR (f, tool_bar_window)), total_cols), newwidth); + if (WINDOWP (f->tool_bar_window)) + WSET (XWINDOW (f->tool_bar_window), total_cols, make_number (newwidth)); } FRAME_LINES (f) = newheight; @@ -6099,7 +6082,7 @@ pass nil for VARIABLE. */) goto changed; if (vecp == end) goto changed; - if (!EQ (*vecp++, FVAR (XFRAME (frame), name))) + if (!EQ (*vecp++, XFRAME (frame)->name)) goto changed; } /* Check that the buffer info matches. */ @@ -6156,7 +6139,7 @@ pass nil for VARIABLE. */) FOR_EACH_FRAME (tail, frame) { *vecp++ = frame; - *vecp++ = FVAR (XFRAME (frame), name); + *vecp++ = XFRAME (frame)->name; } for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { diff --git a/src/doc.c b/src/doc.c index e57b26525e1..d17e90f11c0 100644 --- a/src/doc.c +++ b/src/doc.c @@ -123,7 +123,7 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition) /* sizeof ("../etc/") == 8 */ if (minsize < 8) minsize = 8; - SAFE_ALLOCA (name, char *, minsize + SCHARS (file) + 8); + name = SAFE_ALLOCA (minsize + SCHARS (file) + 8); strcpy (name, SSDATA (docdir)); strcat (name, SSDATA (file)); } @@ -508,7 +508,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) { /* Don't use indirect_function here, or defaliases will apply their docstrings to the base functions (Bug#2603). */ - Lisp_Object fun = SYMBOLP (obj) ? SVAR (XSYMBOL (obj), function) : obj; + Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj; /* The type determines where the docstring is stored. */ diff --git a/src/doprnt.c b/src/doprnt.c index 44dc641d5dd..63f05cb74e2 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -161,10 +161,9 @@ doprnt (char *buffer, ptrdiff_t bufsize, const char *format, if (format_end == 0) format_end = format + strlen (format); - if (format_end - format < sizeof (fixed_buffer) - 1) - fmtcpy = fixed_buffer; - else - SAFE_ALLOCA (fmtcpy, char *, format_end - format + 1); + fmtcpy = (format_end - format < sizeof (fixed_buffer) - 1 + ? fixed_buffer + : SAFE_ALLOCA (format_end - format + 1)); bufsize--; diff --git a/src/dosfns.c b/src/dosfns.c index 162a98382cb..e3adf25d79f 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -468,15 +468,15 @@ void x_set_title (struct frame *f, Lisp_Object name) { /* Don't change the title if it's already NAME. */ - if (EQ (name, FVAR (f, title))) + if (EQ (name, f->title)) return; update_mode_lines = 1; - FVAR (f, title) = name; + FSET (f, title, name); if (NILP (name)) - name = FVAR (f, name); + name = f->name; if (FRAME_MSDOS_P (f)) { diff --git a/src/editfns.c b/src/editfns.c index e657b3ec532..5ac012c8378 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -366,7 +366,7 @@ get_pos_property (Lisp_Object position, register Lisp_Object prop, Lisp_Object o if (NILP (object)) XSETBUFFER (object, current_buffer); else if (WINDOWP (object)) - object = WVAR (XWINDOW (object), buffer); + object = XWINDOW (object)->buffer; if (!BUFFERP (object)) /* pos-property only makes sense in buffers right now, since strings @@ -821,7 +821,7 @@ This function does not move point. */) Lisp_Object save_excursion_save (void) { - int visible = (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) + int visible = (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer); return Fcons (Fpoint_marker (), @@ -874,7 +874,7 @@ save_excursion_restore (Lisp_Object info) and cleaner never to alter the window/buffer connections. */ tem1 = Fcar (tem); if (!NILP (tem1) - && current_buffer != XBUFFER (WVAR (XWINDOW (selected_window), buffer))) + && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) Fswitch_to_buffer (Fcurrent_buffer (), Qnil); #endif /* 0 */ @@ -882,7 +882,7 @@ save_excursion_restore (Lisp_Object info) info = XCDR (info); tem = XCAR (info); tem1 = BVAR (current_buffer, mark_active); - BVAR (current_buffer, mark_active) = tem; + BSET (current_buffer, mark_active, tem); /* If mark is active now, and either was not active or was at a different place, run the activate hook. */ @@ -907,7 +907,7 @@ save_excursion_restore (Lisp_Object info) tem = XCDR (info); if (visible_p && !EQ (tem, selected_window) - && (tem1 = WVAR (XWINDOW (tem), buffer), + && (tem1 = XWINDOW (tem)->buffer, (/* Window is live... */ BUFFERP (tem1) /* ...and it shows the current buffer. */ @@ -946,8 +946,8 @@ usage: (save-excursion &rest BODY) */) } DEFUN ("save-current-buffer", Fsave_current_buffer, Ssave_current_buffer, 0, UNEVALLED, 0, - doc: /* Save the current buffer; execute BODY; restore the current buffer. -Executes BODY just like `progn'. + doc: /* Record which buffer is current; execute BODY; make that buffer current. +BODY is executed just like `progn'. usage: (save-current-buffer &rest BODY) */) (Lisp_Object args) { @@ -1793,7 +1793,7 @@ format_time_string (char const *format, ptrdiff_t formatlen, if (STRING_BYTES_BOUND <= len) string_overflow (); size = len + 1; - SAFE_ALLOCA (buf, char *, size); + buf = SAFE_ALLOCA (size); } UNBLOCK_INPUT; @@ -2072,7 +2072,7 @@ the data it can't find. */) int m = offset / 60; int am = offset < 0 ? - m : m; char buf[sizeof "+00" + INT_STRLEN_BOUND (int)]; - zone_name = make_formatted_string (buf, "%c%02d%02d", + zone_name = make_formatted_string (buf, "%c%02d%02d", (offset < 0 ? '-' : '+'), am / 60, am % 60); } @@ -2816,13 +2816,13 @@ determines whether case is significant or ignored. */) static Lisp_Object subst_char_in_region_unwind (Lisp_Object arg) { - return BVAR (current_buffer, undo_list) = arg; + return BSET (current_buffer, undo_list, arg); } static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object arg) { - return BVAR (current_buffer, filename) = arg; + return BSET (current_buffer, filename, arg); } DEFUN ("subst-char-in-region", Fsubst_char_in_region, @@ -2896,11 +2896,11 @@ Both characters must have the same length of multi-byte form. */) { record_unwind_protect (subst_char_in_region_unwind, BVAR (current_buffer, undo_list)); - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, undo_list, Qt); /* Don't do file-locking. */ record_unwind_protect (subst_char_in_region_unwind_1, BVAR (current_buffer, filename)); - BVAR (current_buffer, filename) = Qnil; + BSET (current_buffer, filename, Qnil); } if (pos_byte < GPT_BYTE) @@ -2982,7 +2982,7 @@ Both characters must have the same length of multi-byte form. */) INC_POS (pos_byte_next); if (! NILP (noundo)) - BVAR (current_buffer, undo_list) = tem; + BSET (current_buffer, undo_list, tem); UNGCPRO; } @@ -3615,9 +3615,13 @@ where flags is [+ #-0]+, width is [0-9]+, and precision is .[0-9]+ The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only affect %d, %e, %f, and %g sequences, and the + flag takes precedence. +The - and 0 flags affect the width specifier, as described below. + The # flag means to use an alternate display form for %o, %x, %X, %e, -%f, and %g sequences. The - and 0 flags affect the width specifier, -as described below. +%f, and %g sequences: for %o, it ensures that the result begins with +\"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\"; +for %e, %f, and %g, it causes a decimal point to be included even if +the precision is zero. The width specifier supplies a lower limit for the length of the printed representation. The padding, if any, normally goes on the @@ -3686,7 +3690,7 @@ usage: (format STRING &rest OBJECTS) */) ptrdiff_t i; if ((SIZE_MAX - formatlen) / sizeof (struct info) <= nargs) memory_full (SIZE_MAX); - SAFE_ALLOCA (info, struct info *, (nargs + 1) * sizeof *info + formatlen); + info = SAFE_ALLOCA ((nargs + 1) * sizeof *info + formatlen); discarded = (char *) &info[nargs + 1]; for (i = 0; i < nargs + 1; i++) { @@ -3933,7 +3937,7 @@ usage: (format STRING &rest OBJECTS) */) /* If this argument has text properties, record where in the result string it appears. */ - if (STRING_INTERVALS (args[n])) + if (string_get_intervals (args[n])) info[n].intervals = arg_intervals = 1; continue; @@ -4277,7 +4281,7 @@ usage: (format STRING &rest OBJECTS) */) arguments has text properties, set up text properties of the result string. */ - if (STRING_INTERVALS (args[0]) || arg_intervals) + if (string_get_intervals (args[0]) || arg_intervals) { Lisp_Object len, new_len, props; struct gcpro gcpro1; @@ -4527,7 +4531,7 @@ Transposing beyond buffer boundaries is an error. */) Lisp_Object buf; XSETBUFFER (buf, current_buffer); - cur_intv = BUF_INTERVALS (current_buffer); + cur_intv = buffer_get_intervals (current_buffer); validate_region (&startr1, &endr1); validate_region (&startr2, &endr2); @@ -4637,7 +4641,7 @@ Transposing beyond buffer boundaries is an error. */) /* Don't use Fset_text_properties: that can cause GC, which can clobber objects stored in the tmp_intervals. */ tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (!NULL_INTERVAL_P (tmp_interval3)) + if (tmp_interval3) set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); /* First region smaller than second. */ @@ -4645,7 +4649,7 @@ Transposing beyond buffer boundaries is an error. */) { USE_SAFE_ALLOCA; - SAFE_ALLOCA (temp, unsigned char *, len2_byte); + temp = SAFE_ALLOCA (len2_byte); /* Don't precompute these addresses. We have to compute them at the last minute, because the relocating allocator might @@ -4663,7 +4667,7 @@ Transposing beyond buffer boundaries is an error. */) { USE_SAFE_ALLOCA; - SAFE_ALLOCA (temp, unsigned char *, len1_byte); + temp = SAFE_ALLOCA (len1_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start1_addr, len1_byte); @@ -4696,14 +4700,14 @@ Transposing beyond buffer boundaries is an error. */) tmp_interval2 = copy_intervals (cur_intv, start2, len2); tmp_interval3 = validate_interval_range (buf, &startr1, &endr1, 0); - if (!NULL_INTERVAL_P (tmp_interval3)) + if (tmp_interval3) set_text_properties_1 (startr1, endr1, Qnil, buf, tmp_interval3); tmp_interval3 = validate_interval_range (buf, &startr2, &endr2, 0); - if (!NULL_INTERVAL_P (tmp_interval3)) + if (tmp_interval3) set_text_properties_1 (startr2, endr2, Qnil, buf, tmp_interval3); - SAFE_ALLOCA (temp, unsigned char *, len1_byte); + temp = SAFE_ALLOCA (len1_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start1_addr, len1_byte); @@ -4729,11 +4733,11 @@ Transposing beyond buffer boundaries is an error. */) tmp_interval2 = copy_intervals (cur_intv, start2, len2); tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (!NULL_INTERVAL_P (tmp_interval3)) + if (tmp_interval3) set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); /* holds region 2 */ - SAFE_ALLOCA (temp, unsigned char *, len2_byte); + temp = SAFE_ALLOCA (len2_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start2_addr, len2_byte); @@ -4762,11 +4766,11 @@ Transposing beyond buffer boundaries is an error. */) tmp_interval2 = copy_intervals (cur_intv, start2, len2); tmp_interval3 = validate_interval_range (buf, &startr1, &endr2, 0); - if (!NULL_INTERVAL_P (tmp_interval3)) + if (tmp_interval3) set_text_properties_1 (startr1, endr2, Qnil, buf, tmp_interval3); /* holds region 1 */ - SAFE_ALLOCA (temp, unsigned char *, len1_byte); + temp = SAFE_ALLOCA (len1_byte); start1_addr = BYTE_POS_ADDR (start1_byte); start2_addr = BYTE_POS_ADDR (start2_byte); memcpy (temp, start1_addr, len1_byte); diff --git a/src/emacs.c b/src/emacs.c index a622ffd20b8..b1407bf5679 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -425,6 +425,16 @@ init_cmdargs (int argc, char **argv, int skip_args) if (!NILP (Vinvocation_directory)) { dir = Vinvocation_directory; +#ifdef WINDOWSNT + /* If we are running from the build directory, set DIR to the + src subdirectory of the Emacs tree, like on Posix + platforms. */ + if (SBYTES (dir) > sizeof ("/i386/") - 1 + && 0 == strcmp (SSDATA (dir) + SBYTES (dir) - sizeof ("/i386/") + 1, + "/i386/")) + dir = Fexpand_file_name (build_string ("../.."), dir); +#else /* !WINDOWSNT */ +#endif name = Fexpand_file_name (Vinvocation_name, dir); while (1) { @@ -1437,6 +1447,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem init_callproc (); /* Must follow init_cmdargs but not init_sys_modes. */ init_lread (); +#ifdef WINDOWSNT + /* Check to see if Emacs has been installed correctly. */ + check_windows_init_file (); +#endif /* Intern the names of all standard functions and variables; define standard keys. */ @@ -2234,6 +2248,12 @@ decode_env_path (const char *evarname, const char *defalt) { const char *path, *p; Lisp_Object lpath, element, tem; +#ifdef WINDOWSNT + int defaulted = 0; + const char *emacs_dir = egetenv ("emacs_dir"); + static const char *emacs_dir_env = "%emacs_dir%/"; + const size_t emacs_dir_len = strlen (emacs_dir_env); +#endif /* It's okay to use getenv here, because this function is only used to initialize variables when Emacs starts up, and isn't called @@ -2243,7 +2263,12 @@ decode_env_path (const char *evarname, const char *defalt) else path = 0; if (!path) - path = defalt; + { + path = defalt; +#ifdef WINDOWSNT + defaulted = 1; +#endif + } #ifdef DOS_NT /* Ensure values from the environment use the proper directory separator. */ if (path) @@ -2262,6 +2287,16 @@ decode_env_path (const char *evarname, const char *defalt) p = path + strlen (path); element = (p - path ? make_string (path, p - path) : build_string (".")); +#ifdef WINDOWSNT + /* Relative file names in the default path are interpreted as + being relative to $emacs_dir. */ + if (emacs_dir && defaulted + && strncmp (path, emacs_dir_env, emacs_dir_len) == 0) + element = Fexpand_file_name (Fsubstring (element, + make_number (emacs_dir_len), + Qnil), + build_string (emacs_dir)); +#endif /* Add /: to the front of the name if it would otherwise be treated as magic. */ @@ -2381,7 +2416,7 @@ Special values: Anything else (in Emacs 24.1, the possibilities are: aix, berkeley-unix, hpux, irix, usg-unix-v) indicates some sort of Unix system. */); Vsystem_type = intern_c_string (SYSTEM_TYPE); - /* The above values are from SYSTEM_TYPE in include files under src/s. */ + /* See configure.ac (and config.nt) for the possible SYSTEM_TYPEs. */ DEFVAR_LISP ("system-configuration", Vsystem_configuration, doc: /* Value is string indicating configuration Emacs was built for. @@ -2397,7 +2432,7 @@ Emacs is running. */); doc: /* Non-nil means Emacs is running without interactive terminal. */); DEFVAR_LISP ("kill-emacs-hook", Vkill_emacs_hook, - doc: /* Hook to be run when `kill-emacs' is called. + doc: /* Hook run when `kill-emacs' is called. Since `kill-emacs' may be invoked when the terminal is disconnected (or in other similar situations), functions placed on this hook should not expect to be able to interact with the user. To ask for confirmation, diff --git a/src/eval.c b/src/eval.c index 64f384f2ca9..b531f790cc5 100644 --- a/src/eval.c +++ b/src/eval.c @@ -976,7 +976,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) tem = Fassq (sym, environment); if (NILP (tem)) { - def = SVAR (XSYMBOL (sym), function); + def = XSYMBOL (sym)->function; if (!EQ (def, Qunbound)) continue; } @@ -1399,7 +1399,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args, Lisp_Object handlers, - Lisp_Object (*hfun) (Lisp_Object)) + Lisp_Object (*hfun) (Lisp_Object err, + ptrdiff_t nargs, + Lisp_Object *args)) { Lisp_Object val; struct catchtag c; @@ -1417,7 +1419,7 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) { - return (*hfun) (c.val); + return (*hfun) (c.val, nargs, args); } c.next = catchlist; catchlist = &c; @@ -1893,9 +1895,9 @@ this does nothing and returns nil. */) CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if (!EQ (SVAR (XSYMBOL (function), function), Qunbound) - && !(CONSP (SVAR (XSYMBOL (function), function)) - && EQ (XCAR (SVAR (XSYMBOL (function), function)), Qautoload))) + if (!EQ (XSYMBOL (function)->function, Qunbound) + && !(CONSP (XSYMBOL (function)->function) + && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) return Qnil; if (NILP (Vpurify_flag)) @@ -2081,7 +2083,7 @@ eval_sub (Lisp_Object form) /* Optimize for no indirection. */ fun = original_fun; if (SYMBOLP (fun) && !EQ (fun, Qunbound) - && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun)) @@ -2266,7 +2268,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ if (SYMBOLP (fun) && !EQ (fun, Qunbound) - && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); if (EQ (fun, Qunbound)) { @@ -2301,7 +2303,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) gcpro1.nvars = 1 + numargs; } - memcpy (funcall_args, args, nargs * sizeof (Lisp_Object)); + memcpy (funcall_args, args, nargs * word_size); /* Spread the last arg we got. Its first element goes in the slot that it used to occupy, hence this value of I. */ i = nargs - 1; @@ -2771,7 +2773,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ fun = original_fun; if (SYMBOLP (fun) && !EQ (fun, Qunbound) - && (fun = SVAR (XSYMBOL (fun), function), SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun)) @@ -2794,7 +2796,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) { internal_args = alloca (XSUBR (fun)->max_args * sizeof *internal_args); - memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); + memcpy (internal_args, args + 1, numargs * word_size); for (i = numargs; i < XSUBR (fun)->max_args; i++) internal_args[i] = Qnil; } @@ -3254,7 +3256,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) local binding, but only if that binding still exists. */ else if (BUFFERP (where) ? !NILP (Flocal_variable_p (symbol, where)) - : !NILP (Fassq (symbol, FVAR (XFRAME (where), param_alist)))) + : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) set_internal (symbol, this_binding.old_value, where, 1); } /* If variable has a trivial value (no forwarding), we can diff --git a/src/fileio.c b/src/fileio.c index 44710323192..eba157ea042 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -3145,12 +3145,12 @@ decide_coding_unwind (Lisp_Object unwind_data) set_buffer_internal (XBUFFER (buffer)); adjust_markers_for_delete (BEG, BEG_BYTE, Z, Z_BYTE); adjust_overlays_for_delete (BEG, Z - BEG); - BUF_INTERVALS (current_buffer) = 0; + buffer_set_intervals (current_buffer, NULL); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); /* Now we are safe to change the buffer's multibyteness directly. */ - BVAR (current_buffer, enable_multibyte_characters) = multibyte; - BVAR (current_buffer, undo_list) = undo_list; + BSET (current_buffer, enable_multibyte_characters, multibyte); + BSET (current_buffer, undo_list, undo_list); return Qnil; } @@ -3486,16 +3486,16 @@ variable `last-coding-system-used' to the coding system actually used. */) buf = XBUFFER (workbuf); delete_all_overlays (buf); - BVAR (buf, directory) = BVAR (current_buffer, directory); - BVAR (buf, read_only) = Qnil; - BVAR (buf, filename) = Qnil; - BVAR (buf, undo_list) = Qt; + BSET (buf, directory, BVAR (current_buffer, directory)); + BSET (buf, read_only, Qnil); + BSET (buf, filename, Qnil); + BSET (buf, undo_list, Qt); eassert (buf->overlays_before == NULL); eassert (buf->overlays_after == NULL); set_buffer_internal (buf); Ferase_buffer (); - BVAR (buf, enable_multibyte_characters) = Qnil; + BSET (buf, enable_multibyte_characters, Qnil); insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -3731,7 +3731,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* If display currently starts at beginning of line, keep it that way. */ - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) == current_buffer) + if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ()); replace_handled = 1; @@ -3888,7 +3888,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* If display currently starts at beginning of line, keep it that way. */ - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) == current_buffer) + if (XBUFFER (XWINDOW (selected_window)->buffer) == current_buffer) XWINDOW (selected_window)->start_at_line_beg = !NILP (Fbolp ()); /* Replace the chars that we need to replace, @@ -4104,8 +4104,8 @@ variable `last-coding-system-used' to the coding system actually used. */) unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters), Fcons (BVAR (current_buffer, undo_list), Fcurrent_buffer ())); - BVAR (current_buffer, enable_multibyte_characters) = Qnil; - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, enable_multibyte_characters, Qnil); + BSET (current_buffer, undo_list, Qt); record_unwind_protect (decide_coding_unwind, unwind_data); if (inserted > 0 && ! NILP (Vset_auto_coding_function)) @@ -4153,7 +4153,7 @@ variable `last-coding-system-used' to the coding system actually used. */) && NILP (replace)) /* Visiting a file with these coding system makes the buffer unibyte. */ - BVAR (current_buffer, enable_multibyte_characters) = Qnil; + BSET (current_buffer, enable_multibyte_characters, Qnil); } coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); @@ -4196,13 +4196,13 @@ variable `last-coding-system-used' to the coding system actually used. */) if (!NILP (visit)) { if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange) - BVAR (current_buffer, undo_list) = Qnil; + BSET (current_buffer, undo_list, Qnil); if (NILP (handler)) { current_buffer->modtime = mtime; current_buffer->modtime_size = st.st_size; - BVAR (current_buffer, filename) = orig_filename; + BSET (current_buffer, filename, orig_filename); } SAVE_MODIFF = MODIFF; @@ -4247,7 +4247,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Save old undo list and don't record undo for decoding. */ old_undo = BVAR (current_buffer, undo_list); - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, undo_list, Qt); if (NILP (replace)) { @@ -4339,7 +4339,7 @@ variable `last-coding-system-used' to the coding system actually used. */) if (NILP (visit)) { - BVAR (current_buffer, undo_list) = old_undo; + BSET (current_buffer, undo_list, old_undo); if (CONSP (old_undo) && inserted != old_inserted) { /* Adjust the last undo record for the size change during @@ -4354,7 +4354,7 @@ variable `last-coding-system-used' to the coding system actually used. */) else /* If undo_list was Qt before, keep it that way. Otherwise start with an empty undo_list. */ - BVAR (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; + BSET (current_buffer, undo_list, EQ (old_undo, Qt) ? Qt : Qnil); unbind_to (count1, Qnil); } @@ -4594,7 +4594,7 @@ This calls `write-region-annotate-functions' at the start, and { SAVE_MODIFF = MODIFF; XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); - BVAR (current_buffer, filename) = visit_file; + BSET (current_buffer, filename, visit_file); } UNGCPRO; return val; @@ -4810,7 +4810,7 @@ This calls `write-region-annotate-functions' at the start, and { SAVE_MODIFF = MODIFF; XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); - BVAR (current_buffer, filename) = visit_file; + BSET (current_buffer, filename, visit_file); update_mode_lines++; } else if (quietly) @@ -5200,7 +5200,7 @@ auto_save_error (Lisp_Object error_val) msg = Fformat (3, args); GCPRO1 (msg); nbytes = SBYTES (msg); - SAFE_ALLOCA (msgbuf, char *, nbytes); + msgbuf = SAFE_ALLOCA (nbytes); memcpy (msgbuf, SDATA (msg), nbytes); for (i = 0; i < 3; ++i) diff --git a/src/filelock.c b/src/filelock.c index e840d3c5c3b..d21d8e7ba02 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -337,31 +337,22 @@ fill_in_lock_file_name (register char *lockfile, register Lisp_Object fn) static int lock_file_1 (char *lfname, int force) { - register int err; - printmax_t boot, pid; - const char *user_name; - const char *host_name; - char *lock_info_str; - ptrdiff_t lock_info_size; + int err; int symlink_errno; USE_SAFE_ALLOCA; /* Call this first because it can GC. */ - boot = get_boot_time (); + printmax_t boot = get_boot_time (); - if (STRINGP (Fuser_login_name (Qnil))) - user_name = SSDATA (Fuser_login_name (Qnil)); - else - user_name = ""; - if (STRINGP (Fsystem_name ())) - host_name = SSDATA (Fsystem_name ()); - else - host_name = ""; - lock_info_size = (strlen (user_name) + strlen (host_name) - + 2 * INT_STRLEN_BOUND (printmax_t) - + sizeof "@.:"); - SAFE_ALLOCA (lock_info_str, char *, lock_info_size); - pid = getpid (); + Lisp_Object luser_name = Fuser_login_name (Qnil); + char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; + Lisp_Object lhost_name = Fsystem_name (); + char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; + ptrdiff_t lock_info_size = (strlen (user_name) + strlen (host_name) + + 2 * INT_STRLEN_BOUND (printmax_t) + + sizeof "@.:"); + char *lock_info_str = SAFE_ALLOCA (lock_info_size); + printmax_t pid = getpid (); esprintf (lock_info_str, boot ? "%s@%s.%"pMd":%"pMd : "%s@%s.%"pMd, user_name, host_name, pid, boot); @@ -593,7 +584,7 @@ lock_file (Lisp_Object fn) locker_size = (strlen (lock_info.user) + strlen (lock_info.host) + INT_STRLEN_BOUND (printmax_t) + sizeof "@ (pid )"); - SAFE_ALLOCA (locker, char *, locker_size); + locker = SAFE_ALLOCA (locker_size); pid = lock_info.pid; esprintf (locker, "%s@%s (pid %"pMd")", lock_info.user, lock_info.host, pid); diff --git a/src/fns.c b/src/fns.c index a8c8cb283b0..12dca917e62 100644 --- a/src/fns.c +++ b/src/fns.c @@ -628,7 +628,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, ptrdiff_t thislen_byte = SBYTES (this); memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this)); - if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) + if (string_get_intervals (this)) { textprops[num_textprops].argnum = argnum; textprops[num_textprops].from = 0; @@ -640,7 +640,7 @@ concat (ptrdiff_t nargs, Lisp_Object *args, /* Copy a single-byte string to a multibyte string. */ else if (STRINGP (this) && STRINGP (val)) { - if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) + if (string_get_intervals (this)) { textprops[num_textprops].argnum = argnum; textprops[num_textprops].from = 0; @@ -903,7 +903,7 @@ string_make_multibyte (Lisp_Object string) if (nbytes == SBYTES (string)) return string; - SAFE_ALLOCA (buf, unsigned char *, nbytes); + buf = SAFE_ALLOCA (nbytes); copy_text (SDATA (string), buf, SBYTES (string), 0, 1); @@ -935,7 +935,7 @@ string_to_multibyte (Lisp_Object string) if (nbytes == SBYTES (string)) return make_multibyte_string (SSDATA (string), nbytes, nbytes); - SAFE_ALLOCA (buf, unsigned char *, nbytes); + buf = SAFE_ALLOCA (nbytes); memcpy (buf, SDATA (string), SBYTES (string)); str_to_multibyte (buf, nbytes, SBYTES (string)); @@ -961,7 +961,7 @@ string_make_unibyte (Lisp_Object string) nchars = SCHARS (string); - SAFE_ALLOCA (buf, unsigned char *, nchars); + buf = SAFE_ALLOCA (nchars); copy_text (SDATA (string), buf, SBYTES (string), 1, 0); @@ -1060,7 +1060,7 @@ If you're not sure, whether to use `string-as-multibyte' or str_as_multibyte (SDATA (new_string), nbytes, SBYTES (string), NULL); string = new_string; - STRING_SET_INTERVALS (string, NULL_INTERVAL); + string_set_intervals (string, NULL); } return string; } @@ -1192,7 +1192,7 @@ value is a new vector that contains the elements between index FROM string, make_number (0), res, Qnil); } else - res = Fvector (to_char - from_char, &AREF (string, from_char)); + res = Fvector (to_char - from_char, aref_addr (string, from_char)); return res; } @@ -1274,7 +1274,7 @@ substring_both (Lisp_Object string, ptrdiff_t from, ptrdiff_t from_byte, string, make_number (0), res, Qnil); } else - res = Fvector (to - from, &AREF (string, from)); + res = Fvector (to - from, aref_addr (string, from)); return res; } @@ -1868,7 +1868,7 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) (Lisp_Object symbol, Lisp_Object propname) { CHECK_SYMBOL (symbol); - return Fplist_get (SVAR (XSYMBOL (symbol), plist), propname); + return Fplist_get (XSYMBOL (symbol)->plist, propname); } DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, @@ -1910,8 +1910,8 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */) (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value) { CHECK_SYMBOL (symbol); - SVAR (XSYMBOL (symbol), plist) - = Fplist_put (SVAR (XSYMBOL (symbol), plist), propname, value); + set_symbol_plist + (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value)); return value; } @@ -2053,8 +2053,8 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2), depth + 1, props)) return 0; - o1 = MVAR (XOVERLAY (o1), plist); - o2 = MVAR (XOVERLAY (o2), plist); + o1 = XOVERLAY (o1)->plist; + o2 = XOVERLAY (o2)->plist; goto tail_recurse; } if (MARKERP (o1)) @@ -2972,7 +2972,7 @@ into shorter lines. */) allength = length + length/3 + 1; allength += allength / MIME_LINE_LENGTH + 1 + 6; - SAFE_ALLOCA (encoded, char *, allength); + encoded = SAFE_ALLOCA (allength); encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg), encoded, length, NILP (no_line_break), !NILP (BVAR (current_buffer, enable_multibyte_characters))); @@ -3027,7 +3027,7 @@ into shorter lines. */) allength += allength / MIME_LINE_LENGTH + 1 + 6; /* We need to allocate enough room for decoding the text. */ - SAFE_ALLOCA (encoded, char *, allength); + encoded = SAFE_ALLOCA (allength); encoded_length = base64_encode_1 (SSDATA (string), encoded, length, NILP (no_line_break), @@ -3171,7 +3171,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ working on a multibyte buffer, each decoded code may occupy at most two bytes. */ allength = multibyte ? length * 2 : length; - SAFE_ALLOCA (decoded, char *, allength); + decoded = SAFE_ALLOCA (allength); move_gap_both (XFASTINT (beg), ibeg); decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg), @@ -3222,7 +3222,7 @@ DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string, length = SBYTES (string); /* We need to allocate enough room for decoding the text. */ - SAFE_ALLOCA (decoded, char *, length); + decoded = SAFE_ALLOCA (length); /* The decoded result should be unibyte. */ decoded_length = base64_decode_1 (SSDATA (string), decoded, length, @@ -3569,7 +3569,7 @@ hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key) /* An upper bound on the size of a hash table index. It must fit in ptrdiff_t and be a valid Emacs fixnum. */ #define INDEX_SIZE_BOUND \ - ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX / sizeof (Lisp_Object))) + ((ptrdiff_t) min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX / word_size)) /* Create and initialize a new hash table. @@ -3663,7 +3663,7 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, /* Set up the free list. */ for (i = 0; i < sz - 1; ++i) - HASH_NEXT (h, i) = make_number (i + 1); + set_hash_next (h, i, make_number (i + 1)); h->next_free = make_number (0); XSET_HASH_TABLE (table, h); @@ -3770,7 +3770,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) the end of the free list. This makes some operations like maphash faster. */ for (i = old_size; i < new_size - 1; ++i) - HASH_NEXT (h, i) = make_number (i + 1); + set_hash_next (h, i, make_number (i + 1)); if (!NILP (h->next_free)) { @@ -3781,7 +3781,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) !NILP (next)) last = next; - HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); + set_hash_next (h, XFASTINT (last), make_number (old_size)); } else XSETFASTINT (h->next_free, old_size); @@ -3792,8 +3792,8 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) { EMACS_UINT hash_code = XUINT (HASH_HASH (h, i)); ptrdiff_t start_of_bucket = hash_code % ASIZE (h->index); - HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); - HASH_INDEX (h, start_of_bucket) = make_number (i); + set_hash_next (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index (h, start_of_bucket, make_number (i)); } } } @@ -3852,16 +3852,16 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, /* Store key/value in the key_and_value vector. */ i = XFASTINT (h->next_free); h->next_free = HASH_NEXT (h, i); - HASH_KEY (h, i) = key; - HASH_VALUE (h, i) = value; + set_hash_key (h, i, key); + set_hash_value (h, i, value); /* Remember its hash code. */ - HASH_HASH (h, i) = make_number (hash); + set_hash_hash (h, i, make_number (hash)); /* Add new entry to its collision chain. */ start_of_bucket = hash % ASIZE (h->index); - HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); - HASH_INDEX (h, start_of_bucket) = make_number (i); + set_hash_next (h, i, HASH_INDEX (h, start_of_bucket)); + set_hash_index (h, start_of_bucket, make_number (i)); return i; } @@ -3892,14 +3892,16 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { /* Take entry out of collision chain. */ if (NILP (prev)) - HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); + set_hash_index (h, start_of_bucket, HASH_NEXT (h, i)); else - HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); + set_hash_next (h, XFASTINT (prev), HASH_NEXT (h, i)); /* Clear slots in key_and_value and add the slots to the free list. */ - HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil; - HASH_NEXT (h, i) = h->next_free; + set_hash_key (h, i, Qnil); + set_hash_value (h, i, Qnil); + set_hash_hash (h, i, Qnil); + set_hash_next (h, i, h->next_free); h->next_free = make_number (i); h->count--; eassert (h->count >= 0); @@ -3925,10 +3927,10 @@ hash_clear (struct Lisp_Hash_Table *h) for (i = 0; i < size; ++i) { - HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil; - HASH_KEY (h, i) = Qnil; - HASH_VALUE (h, i) = Qnil; - HASH_HASH (h, i) = Qnil; + set_hash_next (h, i, i < size - 1 ? make_number (i + 1) : Qnil); + set_hash_key (h, i, Qnil); + set_hash_value (h, i, Qnil); + set_hash_hash (h, i, Qnil); } for (i = 0; i < ASIZE (h->index); ++i) @@ -3992,17 +3994,18 @@ sweep_weak_table (struct Lisp_Hash_Table *h, int remove_entries_p) { /* Take out of collision chain. */ if (NILP (prev)) - HASH_INDEX (h, bucket) = next; + set_hash_index (h, bucket, next); else - HASH_NEXT (h, XFASTINT (prev)) = next; + set_hash_next (h, XFASTINT (prev), next); /* Add to free list. */ - HASH_NEXT (h, i) = h->next_free; + set_hash_next (h, i, h->next_free); h->next_free = idx; /* Clear key, value, and hash. */ - HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; - HASH_HASH (h, i) = Qnil; + set_hash_key (h, i, Qnil); + set_hash_value (h, i, Qnil); + set_hash_hash (h, i, Qnil); h->count--; } @@ -4509,7 +4512,7 @@ VALUE. In any case, return VALUE. */) i = hash_lookup (h, key, &hash); if (i >= 0) - HASH_VALUE (h, i) = value; + set_hash_value (h, i, value); else hash_put (h, key, value, hash); diff --git a/src/font.c b/src/font.c index db454dd6a23..c3040b8aa3f 100644 --- a/src/font.c +++ b/src/font.c @@ -290,7 +290,7 @@ font_pixel_size (FRAME_PTR f, Lisp_Object spec) return XINT (size); if (NILP (size)) return 0; - font_assert (FLOATP (size)); + eassert (FLOATP (size)); point_size = XFLOAT_DATA (size); val = AREF (spec, FONT_DPI_INDEX); if (INTEGERP (val)) @@ -354,8 +354,7 @@ font_style_to_value (enum font_property_index prop, Lisp_Object val, int noerror } if (! noerror) return -1; - if (len == 255) - abort (); + eassert (len < 255); elt = Fmake_vector (make_number (2), make_number (100)); ASET (elt, 1, val); args[0] = table; @@ -404,10 +403,10 @@ font_style_symbolic (Lisp_Object font, enum font_property_index prop, int for_fa table = AREF (font_style_table, prop - FONT_WEIGHT_INDEX); CHECK_VECTOR (table); i = XINT (val) & 0xFF; - font_assert (((i >> 4) & 0xF) < ASIZE (table)); + eassert (((i >> 4) & 0xF) < ASIZE (table)); elt = AREF (table, ((i >> 4) & 0xF)); CHECK_VECTOR (elt); - font_assert ((i & 0xF) + 1 < ASIZE (elt)); + eassert ((i & 0xF) + 1 < ASIZE (elt)); elt = (for_face ? AREF (elt, 1) : AREF (elt, (i & 0xF) + 1)); CHECK_SYMBOL (elt); return elt; @@ -1076,7 +1075,7 @@ font_parse_xlfd (char *name, ptrdiff_t len, Lisp_Object font) { double point_size = -1; - font_assert (FONT_SPEC_P (font)); + eassert (FONT_SPEC_P (font)); p = f[XLFD_POINT_INDEX]; if (*p == '[') point_size = parse_matrix (p); @@ -1197,7 +1196,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) Lisp_Object val; int i, j, len; - font_assert (FONTP (font)); + eassert (FONTP (font)); for (i = FONT_FOUNDRY_INDEX, j = XLFD_FOUNDRY_INDEX; i <= FONT_REGISTRY_INDEX; i++, j++) @@ -1248,7 +1247,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) } val = AREF (font, FONT_SIZE_INDEX); - font_assert (NUMBERP (val) || NILP (val)); + eassert (NUMBERP (val) || NILP (val)); if (INTEGERP (val)) { EMACS_INT v = XINT (val); @@ -1585,8 +1584,7 @@ font_unparse_fcname (Lisp_Object font, int pixel_size, char *name, int nbytes) } else { - if (! FLOATP (val)) - abort (); + eassert (FLOATP (val)); pixel_size = -1; point_size = (int) XFLOAT_DATA (val); } @@ -2138,7 +2136,7 @@ static Lisp_Object font_vconcat_entity_vectors (Lisp_Object list) { int nargs = XINT (Flength (list)); - Lisp_Object *args = alloca (sizeof (Lisp_Object) * nargs); + Lisp_Object *args = alloca (word_size * nargs); int i; for (i = 0; i < nargs; i++, list = XCDR (list)) @@ -2227,7 +2225,7 @@ font_sort_entities (Lisp_Object list, Lisp_Object prefer, Lisp_Object frame, int maxlen = ASIZE (vec); } - SAFE_ALLOCA (data, struct font_sort_data *, (sizeof *data) * maxlen); + data = SAFE_ALLOCA (maxlen * sizeof *data); best_score = 0xFFFFFFFF; best_entity = Qnil; @@ -2540,7 +2538,7 @@ font_finish_cache (FRAME_PTR f, struct font_driver *driver) val = XCDR (cache); while (CONSP (val) && ! EQ (XCAR (XCAR (val)), driver->type)) cache = val, val = XCDR (val); - font_assert (! NILP (val)); + eassert (! NILP (val)); tmp = XCDR (XCAR (val)); XSETCAR (tmp, make_number (XINT (XCAR (tmp)) - 1)); if (XINT (XCAR (tmp)) == 0) @@ -2557,9 +2555,9 @@ font_get_cache (FRAME_PTR f, struct font_driver *driver) Lisp_Object val = driver->get_cache (f); Lisp_Object type = driver->type; - font_assert (CONSP (val)); + eassert (CONSP (val)); for (val = XCDR (val); ! EQ (XCAR (XCAR (val)), type); val = XCDR (val)); - font_assert (CONSP (val)); + eassert (CONSP (val)); /* VAL = ((DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...) ...) */ val = XCDR (XCAR (val)); return val; @@ -2596,7 +2594,7 @@ font_clear_cache (FRAME_PTR f, Lisp_Object cache, struct font_driver *driver) if (! NILP (AREF (val, FONT_TYPE_INDEX))) { - font_assert (font && driver == font->driver); + eassert (font && driver == font->driver); driver->close (f, font); num_fonts--; } @@ -2706,7 +2704,7 @@ font_list_entities (Lisp_Object frame, Lisp_Object spec) int need_filtering = 0; int i; - font_assert (FONT_SPEC_P (spec)); + eassert (FONT_SPEC_P (spec)); if (INTEGERP (AREF (spec, FONT_SIZE_INDEX))) size = XINT (AREF (spec, FONT_SIZE_INDEX)); @@ -2826,7 +2824,7 @@ font_open_entity (FRAME_PTR f, Lisp_Object entity, int pixel_size) int min_width, height; int scaled_pixel_size = pixel_size; - font_assert (FONT_ENTITY_P (entity)); + eassert (FONT_ENTITY_P (entity)); size = AREF (entity, FONT_SIZE_INDEX); if (XINT (size) != 0) scaled_pixel_size = pixel_size = XINT (size); @@ -2903,7 +2901,7 @@ font_close_object (FRAME_PTR f, Lisp_Object font_object) FONT_ADD_LOG ("close", font_object, Qnil); font->driver->close (f, font); #ifdef HAVE_WINDOW_SYSTEM - font_assert (FRAME_X_DISPLAY_INFO (f)->n_fonts); + eassert (FRAME_X_DISPLAY_INFO (f)->n_fonts); FRAME_X_DISPLAY_INFO (f)->n_fonts--; #endif num_fonts--; @@ -2933,7 +2931,7 @@ font_has_char (FRAME_PTR f, Lisp_Object font, int c) return driver_list->driver->has_char (font, c); } - font_assert (FONT_OBJECT_P (font)); + eassert (FONT_OBJECT_P (font)); fontp = XFONT_OBJECT (font); if (fontp->driver->has_char) { @@ -2953,7 +2951,7 @@ font_encode_char (Lisp_Object font_object, int c) { struct font *font; - font_assert (FONT_OBJECT_P (font_object)); + eassert (FONT_OBJECT_P (font_object)); font = XFONT_OBJECT (font_object); return font->driver->encode_char (font, c); } @@ -2964,7 +2962,7 @@ font_encode_char (Lisp_Object font_object, int c) Lisp_Object font_get_name (Lisp_Object font_object) { - font_assert (FONT_OBJECT_P (font_object)); + eassert (FONT_OBJECT_P (font_object)); return AREF (font_object, FONT_NAME_INDEX); } @@ -3250,10 +3248,8 @@ font_open_for_lface (FRAME_PTR f, Lisp_Object entity, Lisp_Object *attrs, Lisp_O { struct face *def = FACE_FROM_ID (f, DEFAULT_FACE_ID); Lisp_Object height = def->lface[LFACE_HEIGHT_INDEX]; - if (INTEGERP (height)) - pt = XINT (height); - else - abort (); /* We should never end up here. */ + eassert (INTEGERP (height)); + pt = XINT (height); } pt /= 10; @@ -3665,7 +3661,7 @@ font_at (int c, ptrdiff_t pos, struct face *face, struct window *w, } } - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); if (! FRAME_WINDOW_P (f)) return Qnil; if (! face) @@ -3723,12 +3719,12 @@ font_range (ptrdiff_t pos, ptrdiff_t *limit, struct window *w, struct face *face face_id = face_at_buffer_position (w, pos, 0, 0, &ignore, *limit, 0, -1); - face = FACE_FROM_ID (XFRAME (WVAR (w, frame)), face_id); + face = FACE_FROM_ID (XFRAME (w->frame), face_id); } } else { - font_assert (face); + eassert (face); pos_byte = string_char_to_byte (string, pos); } @@ -4268,7 +4264,7 @@ DEFUN ("clear-font-cache", Fclear_font_cache, Sclear_font_cache, 0, 0, 0, while (! NILP (val) && ! EQ (XCAR (XCAR (val)), driver_list->driver->type)) val = XCDR (val); - font_assert (! NILP (val)); + eassert (! NILP (val)); tmp = XCDR (XCAR (val)); if (XINT (XCAR (tmp)) == 0) { @@ -4722,7 +4718,7 @@ the corresponding element is nil. */) Lisp_Object elt = AREF (object, XFASTINT (from) + i); CHECK_CHARACTER (elt); } - chars = &(AREF (object, XFASTINT (from))); + chars = aref_addr (object, XFASTINT (from)); } vec = Fmake_vector (make_number (len), Qnil); diff --git a/src/font.h b/src/font.h index 2e374571c67..3e9af6df235 100644 --- a/src/font.h +++ b/src/font.h @@ -858,10 +858,4 @@ extern void font_deferred_log (const char *, Lisp_Object, Lisp_Object); font_deferred_log ((ACTION), (ARG), (RESULT)); \ } while (0) -#ifdef FONT_DEBUG -#define font_assert(X) do {if (!(X)) abort ();} while (0) -#else /* not FONT_DEBUG */ -#define font_assert(X) (void) 0 -#endif /* not FONT_DEBUG */ - #endif /* not EMACS_FONT_H */ diff --git a/src/fontset.c b/src/fontset.c index 858a2e3cd3b..3c7e931d121 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -429,7 +429,7 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) } if (score_changed) - qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object), + qsort (XVECTOR (vec)->contents, size, word_size, fontset_compare_rfontdef); XSETCAR (font_group, make_number (charset_ordered_list_tick)); } @@ -1027,8 +1027,7 @@ make_fontset_for_ascii_face (FRAME_PTR f, int base_fontset_id, struct face *face base_fontset = FONTSET_FROM_ID (base_fontset_id); if (!BASE_FONTSET_P (base_fontset)) base_fontset = FONTSET_BASE (base_fontset); - if (! BASE_FONTSET_P (base_fontset)) - abort (); + eassert (BASE_FONTSET_P (base_fontset)); } else base_fontset = Vdefault_fontset; @@ -1725,8 +1724,7 @@ fontset_from_font (Lisp_Object font_object) fontset_spec = copy_font_spec (font_spec); ASET (fontset_spec, FONT_REGISTRY_INDEX, alias); name = Ffont_xlfd_name (fontset_spec, Qnil); - if (NILP (name)) - abort (); + eassert (!NILP (name)); fontset = make_fontset (Qnil, name, Qnil); Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)), Vfontset_alias_alist); @@ -1841,7 +1839,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0, if (NILP (window)) return Qnil; w = XWINDOW (window); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); face_id = face_at_buffer_position (w, pos, -1, -1, &dummy, pos + 100, 0, -1); } @@ -1893,7 +1891,7 @@ format is the same as above. */) /* Recode fontsets realized on FRAME from the base fontset FONTSET in the table `realized'. */ - realized[0] = alloca (sizeof (Lisp_Object) * ASIZE (Vfontset_table)); + realized[0] = alloca (word_size * ASIZE (Vfontset_table)); for (i = j = 0; i < ASIZE (Vfontset_table); i++) { elt = FONTSET_FROM_ID (i); @@ -1904,7 +1902,7 @@ format is the same as above. */) } realized[0][j] = Qnil; - realized[1] = alloca (sizeof (Lisp_Object) * ASIZE (Vfontset_table)); + realized[1] = alloca (word_size * ASIZE (Vfontset_table)); for (i = j = 0; ! NILP (realized[0][i]); i++) { elt = FONTSET_DEFAULT (realized[0][i]); @@ -2118,7 +2116,7 @@ dump_fontset (Lisp_Object fontset) if (FRAME_LIVE_P (f)) ASET (vec, 1, Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), - FVAR (f, name))); + f->name)); else ASET (vec, 1, Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil)); diff --git a/src/frame.c b/src/frame.c index 9389eccb6f2..ea682835a87 100644 --- a/src/frame.c +++ b/src/frame.c @@ -65,7 +65,7 @@ Lisp_Object Qns_parse_geometry; Lisp_Object Qframep, Qframe_live_p; Lisp_Object Qicon, Qmodeline; -Lisp_Object Qonly; +Lisp_Object Qonly, Qnone; Lisp_Object Qx, Qw32, Qmac, Qpc, Qns; Lisp_Object Qvisible; Lisp_Object Qdisplay_type; @@ -132,15 +132,15 @@ set_menu_bar_lines_1 (Lisp_Object window, int n) struct window *w = XWINDOW (window); w->last_modified = 0; - XSETFASTINT (WVAR (w, top_line), XFASTINT (WVAR (w, top_line)) + n); - XSETFASTINT (WVAR (w, total_lines), XFASTINT (WVAR (w, total_lines)) - n); + WSET (w, top_line, make_number (XFASTINT (w->top_line) + n)); + WSET (w, total_lines, make_number (XFASTINT (w->total_lines) - n)); /* Handle just the top child in a vertical split. */ - if (!NILP (WVAR (w, vchild))) - set_menu_bar_lines_1 (WVAR (w, vchild), n); + if (!NILP (w->vchild)) + set_menu_bar_lines_1 (w->vchild, n); /* Adjust all children in a horizontal split. */ - for (window = WVAR (w, hchild); !NILP (window); window = WVAR (w, next)) + for (window = w->hchild; !NILP (window); window = w->next) { w = XWINDOW (window); set_menu_bar_lines_1 (window, n); @@ -170,7 +170,7 @@ set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; FRAME_MENU_BAR_LINES (f) = nlines; - set_menu_bar_lines_1 (FVAR (f, root_window), nlines - olines); + set_menu_bar_lines_1 (f->root_window, nlines - olines); adjust_glyphs (f); } } @@ -269,7 +269,7 @@ make_frame (int mini_p) /* Initialize Lisp data. Note that allocate_frame initializes all Lisp data to nil, so do it only for slots which should not be nil. */ - FVAR (f, tool_bar_position) = Qtop; + FSET (f, tool_bar_position, Qtop); /* Initialize non-Lisp data. Note that allocate_frame zeroes out all non-Lisp data, so do it only for slots which should not be zero. @@ -289,20 +289,20 @@ make_frame (int mini_p) if (mini_p) { mini_window = make_window (); - WVAR (XWINDOW (root_window), next) = mini_window; - WVAR (XWINDOW (mini_window), prev) = root_window; + WSET (XWINDOW (root_window), next, mini_window); + WSET (XWINDOW (mini_window), prev, root_window); XWINDOW (mini_window)->mini = 1; - WVAR (XWINDOW (mini_window), frame) = frame; - FVAR (f, minibuffer_window) = mini_window; + WSET (XWINDOW (mini_window), frame, frame); + FSET (f, minibuffer_window, mini_window); } else { mini_window = Qnil; - WVAR (XWINDOW (root_window), next) = Qnil; - FVAR (f, minibuffer_window) = Qnil; + WSET (XWINDOW (root_window), next, Qnil); + FSET (f, minibuffer_window, Qnil); } - WVAR (XWINDOW (root_window), frame) = frame; + WSET (XWINDOW (root_window), frame, frame); /* 10 is arbitrary, just so that there is "something there." @@ -311,21 +311,21 @@ make_frame (int mini_p) SET_FRAME_COLS (f, 10); FRAME_LINES (f) = 10; - XSETFASTINT (WVAR (XWINDOW (root_window), total_cols), 10); - XSETFASTINT (WVAR (XWINDOW (root_window), total_lines), (mini_p ? 9 : 10)); + WSET (XWINDOW (root_window), total_cols, make_number (10)); + WSET (XWINDOW (root_window), total_lines, make_number (mini_p ? 9 : 10)); if (mini_p) { - XSETFASTINT (WVAR (XWINDOW (mini_window), total_cols), 10); - XSETFASTINT (WVAR (XWINDOW (mini_window), top_line), 9); - XSETFASTINT (WVAR (XWINDOW (mini_window), total_lines), 1); + WSET (XWINDOW (mini_window), total_cols, make_number (10)); + WSET (XWINDOW (mini_window), top_line, make_number (9)); + WSET (XWINDOW (mini_window), total_lines, make_number (1)); } /* Choose a buffer for the frame's root window. */ { Lisp_Object buf; - WVAR (XWINDOW (root_window), buffer) = Qt; + WSET (XWINDOW (root_window), buffer, Qt); buf = Fcurrent_buffer (); /* If buf is a 'hidden' buffer (i.e. one whose name starts with a space), try to find another one. */ @@ -339,12 +339,12 @@ make_frame (int mini_p) etc. Running Lisp functions at this point surely ends in a SEGV. */ set_window_buffer (root_window, buf, 0, 0); - FVAR (f, buffer_list) = Fcons (buf, Qnil); + FSET (f, buffer_list, Fcons (buf, Qnil)); } if (mini_p) { - WVAR (XWINDOW (mini_window), buffer) = Qt; + WSET (XWINDOW (mini_window), buffer, Qt); set_window_buffer (mini_window, (NILP (Vminibuffer_list) ? get_minibuffer (0) @@ -352,11 +352,11 @@ make_frame (int mini_p) 0, 0); } - FVAR (f, root_window) = root_window; - FVAR (f, selected_window) = root_window; + FSET (f, root_window, root_window); + FSET (f, selected_window, root_window); /* Make sure this window seems more recently used than a newly-created, never-selected window. */ - XWINDOW (FVAR (f, selected_window))->use_time = ++window_select_count; + XWINDOW (f->selected_window)->use_time = ++window_select_count; return f; } @@ -376,7 +376,7 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis CHECK_LIVE_WINDOW (mini_window); if (!NILP (mini_window) - && FRAME_KBOARD (XFRAME (WVAR (XWINDOW (mini_window), frame))) != kb) + && FRAME_KBOARD (XFRAME (XWINDOW (mini_window)->frame)) != kb) error ("Frame and minibuffer must be on the same terminal"); /* Make a frame containing just a root window. */ @@ -393,24 +393,26 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis XSETFRAME (frame_dummy, f); GCPRO1 (frame_dummy); /* If there's no minibuffer frame to use, create one. */ - KVAR (kb, Vdefault_minibuffer_frame) = - call1 (intern ("make-initial-minibuffer-frame"), display); + KSET (kb, Vdefault_minibuffer_frame, + call1 (intern ("make-initial-minibuffer-frame"), display)); UNGCPRO; } - mini_window = FVAR (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)), - minibuffer_window); + mini_window + = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window; } - FVAR (f, minibuffer_window) = mini_window; + FSET (f, minibuffer_window, mini_window); /* Make the chosen minibuffer window display the proper minibuffer, unless it is already showing a minibuffer. */ - if (NILP (Fmemq (WVAR (XWINDOW (mini_window), buffer), Vminibuffer_list))) - Fset_window_buffer (mini_window, - (NILP (Vminibuffer_list) - ? get_minibuffer (0) - : Fcar (Vminibuffer_list)), Qnil); + if (NILP (Fmemq (XWINDOW (mini_window)->buffer, Vminibuffer_list))) + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (mini_window, + (NILP (Vminibuffer_list) + ? get_minibuffer (0) + : Fcar (Vminibuffer_list)), 0, 0); return f; } @@ -437,18 +439,20 @@ make_minibuffer_frame (void) Avoid infinite looping on the window chain by marking next pointer as nil. */ - mini_window = FVAR (f, minibuffer_window) = FVAR (f, root_window); + mini_window = FSET (f, minibuffer_window, f->root_window); XWINDOW (mini_window)->mini = 1; - WVAR (XWINDOW (mini_window), next) = Qnil; - WVAR (XWINDOW (mini_window), prev) = Qnil; - WVAR (XWINDOW (mini_window), frame) = frame; + WSET (XWINDOW (mini_window), next, Qnil); + WSET (XWINDOW (mini_window), prev, Qnil); + WSET (XWINDOW (mini_window), frame, frame); /* Put the proper buffer in that window. */ - Fset_window_buffer (mini_window, - (NILP (Vminibuffer_list) - ? get_minibuffer (0) - : Fcar (Vminibuffer_list)), Qnil); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (mini_window, + (NILP (Vminibuffer_list) + ? get_minibuffer (0) + : Fcar (Vminibuffer_list)), 0, 0); return f; } #endif /* HAVE_WINDOW_SYSTEM */ @@ -478,7 +482,7 @@ make_initial_frame (void) Vframe_list = Fcons (frame, Vframe_list); tty_frame_count = 1; - FVAR (f, name) = build_pure_c_string ("F1"); + FSET (f, name, build_pure_c_string ("F1")); f->visible = 1; f->async_visible = 1; @@ -519,7 +523,7 @@ make_terminal_frame (struct terminal *terminal) XSETFRAME (frame, f); Vframe_list = Fcons (frame, Vframe_list); - FVAR (f, name) = make_formatted_string (name, "F%"pMd, ++tty_frame_count); + FSET (f, name, make_formatted_string (name, "F%"pMd, ++tty_frame_count)); f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */ f->async_visible = 1; /* Don't let visible be cleared later. */ @@ -570,7 +574,7 @@ get_future_frame_param (Lisp_Object parameter, result = Fassq (parameter, supplied_parms); if (NILP (result)) - result = Fassq (parameter, FVAR (XFRAME (selected_frame), param_alist)); + result = Fassq (parameter, XFRAME (selected_frame)->param_alist); if (NILP (result) && current_value != NULL) result = build_string (current_value); if (!NILP (result) && !STRINGP (result)) @@ -689,11 +693,11 @@ affects all frames on the same terminal device. */) /* Make the frame face alist be frame-specific, so that each frame could change its face definitions independently. */ - FVAR (f, face_alist) = Fcopy_alist (FVAR (sf, face_alist)); + FSET (f, face_alist, Fcopy_alist (sf->face_alist)); /* Simple Fcopy_alist isn't enough, because we need the contents of the vectors which are the CDRs of associations in face_alist to be copied as well. */ - for (tem = FVAR (f, face_alist); CONSP (tem); tem = XCDR (tem)) + for (tem = f->face_alist; CONSP (tem); tem = XCDR (tem)) XSETCDR (XCAR (tem), Fcopy_sequence (XCDR (XCAR (tem)))); return frame; } @@ -797,7 +801,7 @@ do_switch_frame (Lisp_Object frame, int track, int for_deletion, Lisp_Object nor if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame))) last_nonminibuf_frame = XFRAME (selected_frame); - Fselect_window (FVAR (XFRAME (frame), selected_window), norecord); + Fselect_window (XFRAME (frame)->selected_window, norecord); /* We want to make sure that the next event generates a frame-switch event to the appropriate frame. This seems kludgy to me, but @@ -843,7 +847,7 @@ to that frame. */) (Lisp_Object event) { /* Preserve prefix arg that the command loop just cleared. */ - KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg; + KSET (current_kboard, Vprefix_arg, Vcurrent_prefix_arg); Frun_hooks (1, &Qmouse_leave_buffer_hook); return do_switch_frame (event, 0, 0, Qnil); } @@ -1238,11 +1242,13 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (FVAR (f, minibuffer_window), minibuf_window)) + if (EQ (f->minibuffer_window, minibuf_window)) { - Fset_window_buffer (FVAR (sf, minibuffer_window), - WVAR (XWINDOW (minibuf_window), buffer), Qnil); - minibuf_window = FVAR (sf, minibuffer_window); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (sf->minibuffer_window, + XWINDOW (minibuf_window)->buffer, 0, 0); + minibuf_window = sf->minibuffer_window; /* If the dying minibuffer window was selected, select the new one. */ @@ -1251,8 +1257,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) } /* Don't let echo_area_window to remain on a deleted frame. */ - if (EQ (FVAR (f, minibuffer_window), echo_area_window)) - echo_area_window = FVAR (sf, minibuffer_window); + if (EQ (f->minibuffer_window, echo_area_window)) + echo_area_window = sf->minibuffer_window; /* Clear any X selections for this frame. */ #ifdef HAVE_X_WINDOWS @@ -1273,8 +1279,8 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* Mark all the windows that used to be on FRAME as deleted, and then remove the reference to them. */ - delete_all_child_windows (FVAR (f, root_window)); - FVAR (f, root_window) = Qnil; + delete_all_child_windows (f->root_window); + FSET (f, root_window, Qnil); Vframe_list = Fdelq (frame, Vframe_list); FRAME_SET_VISIBLE (f, 0); @@ -1283,7 +1289,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) garbage collection. The frame object itself may not be garbage collected until much later, because recent_keys and other data structures can still refer to it. */ - FVAR (f, menu_bar_vector) = Qnil; + FSET (f, menu_bar_vector, Qnil); free_font_driver_list (f); xfree (f->namebuf); @@ -1435,11 +1441,11 @@ delete_frame (Lisp_Object frame, Lisp_Object force) if (NILP (frame_with_minibuf)) abort (); - KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf; + KSET (kb, Vdefault_minibuffer_frame, frame_with_minibuf); } else /* No frames left on this kboard--say no minibuffer either. */ - KVAR (kb, Vdefault_minibuffer_frame) = Qnil; + KSET (kb, Vdefault_minibuffer_frame, Qnil); } /* Cause frame titles to update--necessary if we now have just one frame. */ @@ -1656,7 +1662,7 @@ If omitted, FRAME defaults to the currently selected frame. */) } #endif - make_frame_visible_1 (FVAR (XFRAME (frame), root_window)); + make_frame_visible_1 (XFRAME (frame)->root_window); /* Make menu bar update for the Buffers and Frames menus. */ windows_or_buffers_changed++; @@ -1672,17 +1678,17 @@ make_frame_visible_1 (Lisp_Object window) { struct window *w; - for (;!NILP (window); window = WVAR (w, next)) + for (;!NILP (window); window = w->next) { w = XWINDOW (window); - if (!NILP (WVAR (w, buffer))) - BVAR (XBUFFER (WVAR (w, buffer)), display_time) = Fcurrent_time (); + if (!NILP (w->buffer)) + BSET (XBUFFER (w->buffer), display_time, Fcurrent_time ()); - if (!NILP (WVAR (w, vchild))) - make_frame_visible_1 (WVAR (w, vchild)); - if (!NILP (WVAR (w, hchild))) - make_frame_visible_1 (WVAR (w, hchild)); + if (!NILP (w->vchild)) + make_frame_visible_1 (w->vchild); + if (!NILP (w->hchild)) + make_frame_visible_1 (w->hchild); } } @@ -1710,12 +1716,14 @@ displayed in the terminal. */) error ("Attempt to make invisible the sole visible or iconified frame"); /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (FVAR (XFRAME (frame), minibuffer_window), minibuf_window)) + if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { struct frame *sf = XFRAME (selected_frame); - Fset_window_buffer (FVAR (sf, minibuffer_window), - WVAR (XWINDOW (minibuf_window), buffer), Qnil); - minibuf_window = FVAR (sf, minibuffer_window); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (sf->minibuffer_window, + XWINDOW (minibuf_window)->buffer, 0, 0); + minibuf_window = sf->minibuffer_window; } /* I think this should be done with a hook. */ @@ -1747,13 +1755,15 @@ If omitted, FRAME defaults to the currently selected frame. */) Fhandle_switch_frame (next_frame (frame, Qt)); #endif - /* Don't allow minibuf_window to remain on a deleted frame. */ - if (EQ (FVAR (XFRAME (frame), minibuffer_window), minibuf_window)) + /* Don't allow minibuf_window to remain on an iconified frame. */ + if (EQ (XFRAME (frame)->minibuffer_window, minibuf_window)) { struct frame *sf = XFRAME (selected_frame); - Fset_window_buffer (FVAR (sf, minibuffer_window), - WVAR (XWINDOW (minibuf_window), buffer), Qnil); - minibuf_window = FVAR (sf, minibuffer_window); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (sf->minibuffer_window, + XWINDOW (minibuf_window)->buffer, 0, 0); + minibuf_window = sf->minibuffer_window; } /* I think this should be done with a hook. */ @@ -1907,7 +1917,7 @@ The redirection lasts until `redirect-frame-focus' is called to change it. */) f = XFRAME (frame); - FVAR (f, focus_frame) = focus_frame; + FSET (f, focus_frame, focus_frame); if (FRAME_TERMINAL (f)->frame_rehighlight_hook) (*FRAME_TERMINAL (f)->frame_rehighlight_hook) (f); @@ -1940,7 +1950,7 @@ get_frame_param (register struct frame *frame, Lisp_Object prop) { register Lisp_Object tem; - tem = Fassq (prop, FVAR (frame, param_alist)); + tem = Fassq (prop, frame->param_alist); if (EQ (tem, Qnil)) return tem; return Fcdr (tem); @@ -1952,7 +1962,7 @@ get_frame_param (register struct frame *frame, Lisp_Object prop) Lisp_Object frame_buffer_predicate (Lisp_Object frame) { - return FVAR (XFRAME (frame), buffer_predicate); + return XFRAME (frame)->buffer_predicate; } /* Return the buffer-list of the selected frame. */ @@ -1960,7 +1970,7 @@ frame_buffer_predicate (Lisp_Object frame) static Lisp_Object frame_buffer_list (Lisp_Object frame) { - return FVAR (XFRAME (frame), buffer_list); + return XFRAME (frame)->buffer_list; } /* Discard BUFFER from the buffer-list and buried-buffer-list of each frame. */ @@ -1972,10 +1982,10 @@ frames_discard_buffer (Lisp_Object buffer) FOR_EACH_FRAME (tail, frame) { - FVAR (XFRAME (frame), buffer_list) - = Fdelq (buffer, FVAR (XFRAME (frame), buffer_list)); - FVAR (XFRAME (frame), buried_buffer_list) - = Fdelq (buffer, FVAR (XFRAME (frame), buried_buffer_list)); + FSET (XFRAME (frame), buffer_list, + Fdelq (buffer, XFRAME (frame)->buffer_list)); + FSET (XFRAME (frame), buried_buffer_list, + Fdelq (buffer, XFRAME (frame)->buried_buffer_list)); } } @@ -2023,8 +2033,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name) /* Check for no change needed in this very common case before we do any consing. */ - if (frame_name_fnn_p (SSDATA (FVAR (f, name)), - SBYTES (FVAR (f, name)))) + if (frame_name_fnn_p (SSDATA (f->name), SBYTES (f->name))) return; name = make_formatted_string (namebuf, "F%"pMd, ++tty_frame_count); @@ -2034,7 +2043,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name) CHECK_STRING (name); /* Don't change the name if it's already NAME. */ - if (! NILP (Fstring_equal (name, FVAR (f, name)))) + if (! NILP (Fstring_equal (name, f->name))) return; /* Don't allow the user to set the frame name to F, so it @@ -2043,7 +2052,7 @@ set_term_frame_name (struct frame *f, Lisp_Object name) error ("Frame names of the form F are usurped by Emacs"); } - FVAR (f, name) = name; + FSET (f, name, name); update_mode_lines = 1; } @@ -2060,7 +2069,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) for (; CONSP (val); val = XCDR (val)) if (!NILP (Fbuffer_live_p (XCAR (val)))) list = Fcons (XCAR (val), list); - FVAR (f, buffer_list) = Fnreverse (list); + FSET (f, buffer_list, Fnreverse (list)); return; } if (EQ (prop, Qburied_buffer_list)) @@ -2069,7 +2078,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) for (; CONSP (val); val = XCDR (val)) if (!NILP (Fbuffer_live_p (XCAR (val)))) list = Fcons (XCAR (val), list); - FVAR (f, buried_buffer_list) = Fnreverse (list); + FSET (f, buried_buffer_list, Fnreverse (list)); return; } @@ -2104,9 +2113,9 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) FRAME_TTY (f)->previous_frame = NULL; /* Update the frame parameter alist. */ - old_alist_elt = Fassq (prop, FVAR (f, param_alist)); + old_alist_elt = Fassq (prop, f->param_alist); if (EQ (old_alist_elt, Qnil)) - FVAR (f, param_alist) = Fcons (Fcons (prop, val), FVAR (f, param_alist)); + FSET (f, param_alist, Fcons (Fcons (prop, val), f->param_alist)); else Fsetcdr (old_alist_elt, val); @@ -2114,7 +2123,7 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) in addition to the alist. */ if (EQ (prop, Qbuffer_predicate)) - FVAR (f, buffer_predicate) = val; + FSET (f, buffer_predicate, val); if (! FRAME_WINDOW_P (f)) { @@ -2130,11 +2139,11 @@ store_frame_param (struct frame *f, Lisp_Object prop, Lisp_Object val) error ("Surrogate minibuffer windows must be minibuffer windows"); if ((FRAME_HAS_MINIBUF_P (f) || FRAME_MINIBUF_ONLY_P (f)) - && !EQ (val, FVAR (f, minibuffer_window))) + && !EQ (val, f->minibuffer_window)) error ("Can't change the surrogate minibuffer of a frame with its own minibuffer"); /* Install the chosen minibuffer window, with proper buffer. */ - FVAR (f, minibuffer_window) = val; + FSET (f, minibuffer_window, val); } } @@ -2159,7 +2168,7 @@ If FRAME is omitted, return information on the currently selected frame. */) if (!FRAME_LIVE_P (f)) return Qnil; - alist = Fcopy_alist (FVAR (f, param_alist)); + alist = Fcopy_alist (f->param_alist); GCPRO1 (alist); if (!FRAME_WINDOW_P (f)) @@ -2205,7 +2214,7 @@ If FRAME is omitted, return information on the currently selected frame. */) : FRAME_W32_P (f) ? "w32term" :"tty")); } - store_in_alist (&alist, Qname, FVAR (f, name)); + store_in_alist (&alist, Qname, f->name); height = (f->new_text_lines ? f->new_text_lines : FRAME_LINES (f)); store_in_alist (&alist, Qheight, make_number (height)); width = (f->new_text_cols ? f->new_text_cols : FRAME_COLS (f)); @@ -2218,7 +2227,7 @@ If FRAME is omitted, return information on the currently selected frame. */) store_in_alist (&alist, Qunsplittable, (FRAME_NO_SPLIT_P (f) ? Qt : Qnil)); store_in_alist (&alist, Qbuffer_list, frame_buffer_list (frame)); store_in_alist (&alist, Qburied_buffer_list, - FVAR (XFRAME (frame), buried_buffer_list)); + XFRAME (frame)->buried_buffer_list); /* I think this should be done with a hook. */ #ifdef HAVE_WINDOW_SYSTEM @@ -2259,7 +2268,7 @@ If FRAME is nil, describe the currently selected frame. */) { /* Avoid consing in frequent cases. */ if (EQ (parameter, Qname)) - value = FVAR (f, name); + value = f->name; #ifdef HAVE_X_WINDOWS else if (EQ (parameter, Qdisplay) && FRAME_X_P (f)) value = XCAR (FRAME_X_DISPLAY_INFO (f)->name_list_element); @@ -2267,7 +2276,7 @@ If FRAME is nil, describe the currently selected frame. */) else if (EQ (parameter, Qbackground_color) || EQ (parameter, Qforeground_color)) { - value = Fassq (parameter, FVAR (f, param_alist)); + value = Fassq (parameter, f->param_alist); if (CONSP (value)) { value = XCDR (value); @@ -2305,7 +2314,7 @@ If FRAME is nil, describe the currently selected frame. */) } else if (EQ (parameter, Qdisplay_type) || EQ (parameter, Qbackground_mode)) - value = Fcdr (Fassq (parameter, FVAR (f, param_alist))); + value = Fcdr (Fassq (parameter, f->param_alist)); else /* FIXME: Avoid this code path at all (as well as code duplication) by sharing more code with Fframe_parameters. */ @@ -2891,14 +2900,14 @@ x_set_frame_parameters (FRAME_PTR f, Lisp_Object alist) if (! TYPE_RANGED_INTEGERP (int, icon_left)) { icon_left_no_change = 1; - icon_left = Fcdr (Fassq (Qicon_left, FVAR (f, param_alist))); + icon_left = Fcdr (Fassq (Qicon_left, f->param_alist)); if (NILP (icon_left)) XSETINT (icon_left, 0); } if (! TYPE_RANGED_INTEGERP (int, icon_top)) { icon_top_no_change = 1; - icon_top = Fcdr (Fassq (Qicon_top, FVAR (f, param_alist))); + icon_top = Fcdr (Fassq (Qicon_top, f->param_alist)); if (NILP (icon_top)) XSETINT (icon_top, 0); } @@ -3058,7 +3067,7 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) store_in_alist (alistptr, Qouter_window_id, make_formatted_string (buf, "%lu", w)); #endif - store_in_alist (alistptr, Qicon_name, FVAR (f, icon_name)); + store_in_alist (alistptr, Qicon_name, f->icon_name); FRAME_SAMPLE_VISIBILITY (f); store_in_alist (alistptr, Qvisibility, (FRAME_VISIBLE_P (f) ? Qt @@ -3072,7 +3081,7 @@ x_report_frame_params (struct frame *f, Lisp_Object *alistptr) XSETFASTINT (tem, 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, FVAR (f, tool_bar_position)); + store_in_alist (alistptr, Qtool_bar_position, f->tool_bar_position); } @@ -3132,7 +3141,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object new_value, Lisp_Object old_valu signal_error ("Invalid screen-gamma", new_value); /* Apply the new gamma value to the frame background. */ - bgcolor = Fassq (Qbackground_color, FVAR (f, param_alist)); + bgcolor = Fassq (Qbackground_color, f->param_alist); if (CONSP (bgcolor) && (bgcolor = XCDR (bgcolor), STRINGP (bgcolor))) { Lisp_Object parm_index = Fget (Qbackground_color, Qx_frame_parameter); @@ -3461,7 +3470,7 @@ x_icon_type (FRAME_PTR f) { Lisp_Object tem; - tem = assq_no_quit (Qicon_type, FVAR (f, param_alist)); + tem = assq_no_quit (Qicon_type, f->param_alist); if (CONSP (tem)) return XCDR (tem); else @@ -3697,8 +3706,6 @@ display_x_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, Lisp_Objec char * x_get_resource_string (const char *attribute, const char *class) { - char *name_key; - char *class_key; char *result; struct frame *sf = SELECTED_FRAME (); ptrdiff_t invocation_namelen = SBYTES (Vinvocation_name); @@ -3706,8 +3713,8 @@ x_get_resource_string (const char *attribute, const char *class) /* Allocate space for the components, the dots which separate them, and the final '\0'. */ - SAFE_ALLOCA (name_key, char *, invocation_namelen + strlen (attribute) + 2); - class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2); + char *name_key = SAFE_ALLOCA (invocation_namelen + strlen (attribute) + 2); + char *class_key = alloca ((sizeof (EMACS_CLASS) - 1) + strlen (class) + 2); esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute); sprintf (class_key, "%s.%s", EMACS_CLASS, class); @@ -4205,6 +4212,7 @@ syms_of_frame (void) DEFSYM (Qminibuffer, "minibuffer"); DEFSYM (Qmodeline, "modeline"); DEFSYM (Qonly, "only"); + DEFSYM (Qnone, "none"); DEFSYM (Qwidth, "width"); DEFSYM (Qgeometry, "geometry"); DEFSYM (Qicon_left, "icon-left"); @@ -4353,7 +4361,7 @@ The pointer becomes visible again when the mouse is moved. */); Vmake_pointer_invisible = Qt; DEFVAR_LISP ("delete-frame-functions", Vdelete_frame_functions, - doc: /* Functions to be run before deleting a frame. + doc: /* Functions run before deleting a frame. The functions are run with one arg, the frame to be deleted. See `delete-frame'. diff --git a/src/frame.h b/src/frame.h index 22c0125ace9..e07974fb4d2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -80,9 +80,9 @@ struct terminal; struct font_driver_list; -/* Most code should use this macro to access Lisp fields in struct frame. */ +/* Most code should use this macro to set Lisp field in struct frame. */ -#define FVAR(frame, field) ((frame)->INTERNAL_FIELD (field)) +#define FSET(f, field, value) ((f)->field = (value)) struct frame { @@ -93,15 +93,15 @@ struct frame /* Name of this frame: a Lisp string. It is used for looking up resources, as well as for the title in some cases. */ - Lisp_Object INTERNAL_FIELD (name); + Lisp_Object name; /* The name to use for the icon, the last time it was refreshed. nil means not explicitly specified. */ - Lisp_Object INTERNAL_FIELD (icon_name); + Lisp_Object icon_name; /* This is the frame title specified explicitly, if any. Usually it is nil. */ - Lisp_Object INTERNAL_FIELD (title); + Lisp_Object title; /* The frame which should receive keystrokes that occur in this frame, or nil if they should go to the frame itself. This is @@ -114,29 +114,29 @@ struct frame to shift from one frame to the other, any redirections to the original frame are shifted to the newly selected frame; if focus_frame is nil, Fselect_frame will leave it alone. */ - Lisp_Object INTERNAL_FIELD (focus_frame); + Lisp_Object focus_frame; /* This frame's root window. Every frame has one. If the frame has only a minibuffer window, this is it. Otherwise, if the frame has a minibuffer window, this is its sibling. */ - Lisp_Object INTERNAL_FIELD (root_window); + Lisp_Object root_window; /* This frame's selected window. Each frame has its own window hierarchy and one of the windows in it is selected within the frame. The selected window of the selected frame is Emacs's selected window. */ - Lisp_Object INTERNAL_FIELD (selected_window); + Lisp_Object selected_window; /* This frame's minibuffer window. Most frames have their own minibuffer windows, but only the selected frame's minibuffer window can actually appear to exist. */ - Lisp_Object INTERNAL_FIELD (minibuffer_window); + Lisp_Object minibuffer_window; /* Parameter alist of this frame. These are the parameters specified when creating the frame or modified with modify-frame-parameters. */ - Lisp_Object INTERNAL_FIELD (param_alist); + Lisp_Object param_alist; /* List of scroll bars on this frame. Actually, we don't specify exactly what is stored here at all; the @@ -145,51 +145,51 @@ struct frame instead of in the `device' structure so that the garbage collector doesn't need to look inside the window-system-dependent structure. */ - Lisp_Object INTERNAL_FIELD (scroll_bars); - Lisp_Object INTERNAL_FIELD (condemned_scroll_bars); + Lisp_Object scroll_bars; + Lisp_Object condemned_scroll_bars; /* Vector describing the items to display in the menu bar. Each item has four elements in this vector. They are KEY, STRING, SUBMAP, and HPOS. (HPOS is not used in when the X toolkit is in use.) There are four additional elements of nil at the end, to terminate. */ - Lisp_Object INTERNAL_FIELD (menu_bar_items); + Lisp_Object menu_bar_items; /* Alist of elements (FACE-NAME . FACE-VECTOR-DATA). */ - Lisp_Object INTERNAL_FIELD (face_alist); + Lisp_Object face_alist; /* A vector that records the entire structure of this frame's menu bar. For the format of the data, see extensive comments in xmenu.c. Only the X toolkit version uses this. */ - Lisp_Object INTERNAL_FIELD (menu_bar_vector); + Lisp_Object menu_bar_vector; /* Predicate for selecting buffers for other-buffer. */ - Lisp_Object INTERNAL_FIELD (buffer_predicate); + Lisp_Object buffer_predicate; /* List of buffers viewed in this frame, for other-buffer. */ - Lisp_Object INTERNAL_FIELD (buffer_list); + Lisp_Object buffer_list; /* List of buffers that were viewed, then buried in this frame. The most recently buried buffer is first. For last-buffer. */ - Lisp_Object INTERNAL_FIELD (buried_buffer_list); + Lisp_Object buried_buffer_list; /* A dummy window used to display menu bars under X when no X toolkit support is available. */ - Lisp_Object INTERNAL_FIELD (menu_bar_window); + Lisp_Object menu_bar_window; /* A window used to display the tool-bar of a frame. */ - Lisp_Object INTERNAL_FIELD (tool_bar_window); + Lisp_Object tool_bar_window; /* Desired and current tool-bar items. */ - Lisp_Object INTERNAL_FIELD (tool_bar_items); + Lisp_Object tool_bar_items; /* Where tool bar is, can be left, right, top or bottom. The native tool bar only supports top. */ - Lisp_Object INTERNAL_FIELD (tool_bar_position); + Lisp_Object tool_bar_position; /* Desired and current contents displayed in tool_bar_window. */ - Lisp_Object INTERNAL_FIELD (desired_tool_bar_string); - Lisp_Object INTERNAL_FIELD (current_tool_bar_string); + Lisp_Object desired_tool_bar_string; + Lisp_Object current_tool_bar_string; /* Beyond here, there should be no more Lisp_Object components. */ @@ -511,7 +511,7 @@ typedef struct frame *FRAME_PTR; #define XSETFRAME(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FRAME)) /* Given a window, return its frame as a Lisp_Object. */ -#define WINDOW_FRAME(w) WVAR (w, frame) +#define WINDOW_FRAME(w) w->frame /* Test a frame for particular kinds of display methods. */ #define FRAME_INITIAL_P(f) ((f)->output_method == output_initial) @@ -640,13 +640,13 @@ typedef struct frame *FRAME_PTR; #define FRAME_WINDOW_SIZES_CHANGED(f) (f)->window_sizes_changed /* The minibuffer window of frame F, if it has one; otherwise nil. */ -#define FRAME_MINIBUF_WINDOW(f) FVAR (f, minibuffer_window) +#define FRAME_MINIBUF_WINDOW(f) f->minibuffer_window /* The root window of the window tree of frame F. */ -#define FRAME_ROOT_WINDOW(f) FVAR (f, root_window) +#define FRAME_ROOT_WINDOW(f) f->root_window /* The currently selected window of the window tree of frame F. */ -#define FRAME_SELECTED_WINDOW(f) FVAR (f, selected_window) +#define FRAME_SELECTED_WINDOW(f) f->selected_window #define FRAME_INSERT_COST(f) (f)->insert_line_cost #define FRAME_DELETE_COST(f) (f)->delete_line_cost @@ -654,7 +654,7 @@ typedef struct frame *FRAME_PTR; #define FRAME_DELETEN_COST(f) (f)->delete_n_lines_cost #define FRAME_MESSAGE_BUF(f) (f)->message_buf #define FRAME_SCROLL_BOTTOM_VPOS(f) (f)->scroll_bottom_vpos -#define FRAME_FOCUS_FRAME(f) FVAR (f, focus_frame) +#define FRAME_FOCUS_FRAME(f) f->focus_frame /* Nonzero if frame F supports scroll bars. If this is zero, then it is impossible to enable scroll bars @@ -755,10 +755,10 @@ typedef struct frame *FRAME_PTR; /* Nonzero if frame F has scroll bars. */ -#define FRAME_SCROLL_BARS(f) (FVAR (f, scroll_bars)) +#define FRAME_SCROLL_BARS(f) (f->scroll_bars) -#define FRAME_CONDEMNED_SCROLL_BARS(f) (FVAR (f, condemned_scroll_bars)) -#define FRAME_MENU_BAR_ITEMS(f) (FVAR (f, menu_bar_items)) +#define FRAME_CONDEMNED_SCROLL_BARS(f) (f->condemned_scroll_bars) +#define FRAME_MENU_BAR_ITEMS(f) (f->menu_bar_items) #define FRAME_COST_BAUD_RATE(f) ((f)->cost_calculation_baud_rate) #define FRAME_DESIRED_CURSOR(f) ((f)->desired_cursor) @@ -826,10 +826,10 @@ typedef struct frame *FRAME_PTR; supported. An alternate definition of the macro would expand to something which executes the statement once. */ -#define FOR_EACH_FRAME(list_var, frame_var) \ - for ((list_var) = Vframe_list; \ - (CONSP (list_var) \ - && (frame_var = XCAR (list_var), 1)); \ +#define FOR_EACH_FRAME(list_var, frame_var) \ + for ((list_var) = Vframe_list; \ + (CONSP (list_var) \ + && (frame_var = XCAR (list_var), 1)); \ list_var = XCDR (list_var)) diff --git a/src/fringe.c b/src/fringe.c index 374522989f6..97d03a2bfae 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -692,7 +692,7 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor) { Lisp_Object cmap, bm = Qnil; - if ((cmap = BVAR (XBUFFER (WVAR (w, buffer)), fringe_cursor_alist)), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) { bm = Fassq (cursor, cmap); if (CONSP (bm)) @@ -729,7 +729,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in If partial, lookup partial bitmap in default value if not found here. If not partial, or no partial spec is present, use non-partial bitmap. */ - if ((cmap = BVAR (XBUFFER (WVAR (w, buffer)), fringe_indicator_alist)), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) { bm1 = Fassq (bitmap, cmap); if (CONSP (bm1)) @@ -956,7 +956,7 @@ update_window_fringes (struct window *w, int keep_current_p) return 0; if (!MINI_WINDOW_P (w) - && (ind = BVAR (XBUFFER (WVAR (w, buffer)), indicate_buffer_boundaries), !NILP (ind))) + && (ind = BVAR (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) { if (EQ (ind, Qleft) || EQ (ind, Qright)) boundary_top = boundary_bot = arrow_top = arrow_bot = ind; @@ -997,7 +997,7 @@ update_window_fringes (struct window *w, int keep_current_p) { if (top_ind_rn < 0 && row->visible_height > 0) { - if (MATRIX_ROW_START_CHARPOS (row) <= BUF_BEGV (XBUFFER (WVAR (w, buffer))) + if (MATRIX_ROW_START_CHARPOS (row) <= BUF_BEGV (XBUFFER (w->buffer)) && !MATRIX_ROW_PARTIALLY_VISIBLE_AT_TOP_P (w, row)) row->indicate_bob_p = !NILP (boundary_top); else @@ -1007,7 +1007,7 @@ update_window_fringes (struct window *w, int keep_current_p) if (bot_ind_rn < 0) { - if (MATRIX_ROW_END_CHARPOS (row) >= BUF_ZV (XBUFFER (WVAR (w, buffer))) + if (MATRIX_ROW_END_CHARPOS (row) >= BUF_ZV (XBUFFER (w->buffer)) && !MATRIX_ROW_PARTIALLY_VISIBLE_AT_BOTTOM_P (w, row)) row->indicate_eob_p = !NILP (boundary_bot), bot_ind_rn = rn; else if (y + row->height >= yb) @@ -1017,7 +1017,7 @@ update_window_fringes (struct window *w, int keep_current_p) } } - empty_pos = BVAR (XBUFFER (WVAR (w, buffer)), indicate_empty_lines); + empty_pos = BVAR (XBUFFER (w->buffer), indicate_empty_lines); if (!NILP (empty_pos) && !EQ (empty_pos, Qright)) empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft; @@ -1338,8 +1338,8 @@ compute_fringe_widths (struct frame *f, int redraw) int o_right = FRAME_RIGHT_FRINGE_WIDTH (f); int o_cols = FRAME_FRINGE_COLS (f); - Lisp_Object left_fringe = Fassq (Qleft_fringe, FVAR (f, param_alist)); - Lisp_Object right_fringe = Fassq (Qright_fringe, FVAR (f, param_alist)); + Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist); + Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist); int left_fringe_width, right_fringe_width; if (!NILP (left_fringe)) @@ -1740,7 +1740,7 @@ Return nil if POS is not visible in WINDOW. */) else if (w == XWINDOW (selected_window)) textpos = PT; else - textpos = XMARKER (WVAR (w, pointm))->charpos; + textpos = XMARKER (w->pointm)->charpos; row = MATRIX_FIRST_TEXT_ROW (w->current_matrix); row = row_containing_pos (w, textpos, row, NULL, 0); diff --git a/src/gnutls.c b/src/gnutls.c index 9895936c246..5189f2098cf 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -830,7 +830,7 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_state = NULL; XPROCESS (proc)->gnutls_x509_cred = NULL; XPROCESS (proc)->gnutls_anon_cred = NULL; - XPROCESS (proc)->gnutls_cred_type = type; + PSET (XPROCESS (proc), gnutls_cred_type, type); GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; GNUTLS_LOG (1, max_log_level, "allocating credentials"); diff --git a/src/gtkutil.c b/src/gtkutil.c index aca5d65f0e3..6638f375a2c 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include "lisp.h" #include "xterm.h" #include "blockinput.h" @@ -75,6 +76,18 @@ along with GNU Emacs. If not, see . */ #define remove_submenu(w) gtk_menu_item_remove_submenu ((w)) #endif +#if GTK_MAJOR_VERSION > 3 || (GTK_MAJOR_VERSION == 3 && GTK_MINOR_VERSION >= 2) +#define USE_NEW_GTK_FONT_CHOOSER 1 +#else +#define USE_NEW_GTK_FONT_CHOOSER 0 +#define gtk_font_chooser_dialog_new(x, y) \ + gtk_font_selection_dialog_new (x) +#undef GTK_FONT_CHOOSER +#define GTK_FONT_CHOOSER(x) GTK_FONT_SELECTION_DIALOG (x) +#define gtk_font_chooser_set_font(x, y) \ + gtk_font_selection_dialog_set_font_name (x, y) +#endif + #ifndef HAVE_GTK3 #ifdef USE_GTK_TOOLTIP #define gdk_window_get_screen(w) gdk_drawable_get_screen (w) @@ -98,6 +111,16 @@ along with GNU Emacs. If not, see . */ static void update_theme_scrollbar_width (void); +#define TB_INFO_KEY "xg_frame_tb_info" +struct xg_frame_tb_info +{ + Lisp_Object last_tool_bar; + Lisp_Object style; + int n_last_items; + int hmargin, vmargin; + GtkTextDirection dir; +}; + /*********************************************************************** Display handling functions @@ -1148,10 +1171,10 @@ xg_create_frame_widgets (FRAME_PTR f) gtk_widget_set_name (wfixed, SSDATA (Vx_resource_name)); /* If this frame has a title or name, set it in the title bar. */ - if (! NILP (FVAR (f, title))) - title = SSDATA (ENCODE_UTF_8 (FVAR (f, title))); - else if (! NILP (FVAR (f, name))) - title = SSDATA (ENCODE_UTF_8 (FVAR (f, name))); + if (! NILP (f->title)) + title = SSDATA (ENCODE_UTF_8 (f->title)); + else if (! NILP (f->name)) + title = SSDATA (ENCODE_UTF_8 (f->name)); if (title) gtk_window_set_title (GTK_WINDOW (wtop), title); @@ -1265,6 +1288,12 @@ xg_free_frame_widgets (FRAME_PTR f) #ifdef USE_GTK_TOOLTIP struct x_output *x = f->output_data.x; #endif + struct xg_frame_tb_info *tbinfo + = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY); + if (tbinfo) + xfree (tbinfo); + gtk_widget_destroy (FRAME_GTK_OUTER_WIDGET (f)); FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */ FRAME_GTK_OUTER_WIDGET (f) = 0; @@ -1979,7 +2008,39 @@ xg_get_file_name (FRAME_PTR f, return fn; } +/*********************************************************************** + GTK font chooser + ***********************************************************************/ + #ifdef HAVE_FREETYPE + +#if USE_NEW_GTK_FONT_CHOOSER + +extern Lisp_Object Qnormal; +extern Lisp_Object Qextra_light, Qlight, Qsemi_light, Qsemi_bold; +extern Lisp_Object Qbold, Qextra_bold, Qultra_bold; +extern Lisp_Object Qoblique, Qitalic; + +#define XG_WEIGHT_TO_SYMBOL(w) \ + (w <= PANGO_WEIGHT_THIN ? Qextra_light \ + : w <= PANGO_WEIGHT_ULTRALIGHT ? Qlight \ + : w <= PANGO_WEIGHT_LIGHT ? Qsemi_light \ + : w < PANGO_WEIGHT_MEDIUM ? Qnormal \ + : w <= PANGO_WEIGHT_SEMIBOLD ? Qsemi_bold \ + : w <= PANGO_WEIGHT_BOLD ? Qbold \ + : w <= PANGO_WEIGHT_HEAVY ? Qextra_bold \ + : Qultra_bold) + +#define XG_STYLE_TO_SYMBOL(s) \ + (s == PANGO_STYLE_OBLIQUE ? Qoblique \ + : s == PANGO_STYLE_ITALIC ? Qitalic \ + : Qnormal) + +#endif /* USE_NEW_GTK_FONT_CHOOSER */ + + +static char *x_last_font_name; + /* Pop up a GTK font selector and return the name of the font the user selects, as a C string. The returned font name follows GTK's own format: @@ -1989,25 +2050,40 @@ xg_get_file_name (FRAME_PTR f, This can be parsed using font_parse_fcname in font.c. DEFAULT_NAME, if non-zero, is the default font name. */ -char * -xg_get_font_name (FRAME_PTR f, const char *default_name) +Lisp_Object +xg_get_font (FRAME_PTR f, const char *default_name) { GtkWidget *w; - char *fontname = NULL; int done = 0; + Lisp_Object font = Qnil; #if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) sigblock (sigmask (__SIGRTMIN)); #endif /* HAVE_PTHREAD */ - w = gtk_font_selection_dialog_new ("Pick a font"); - if (!default_name) - default_name = "Monospace 10"; - gtk_font_selection_dialog_set_font_name (GTK_FONT_SELECTION_DIALOG (w), - default_name); + w = gtk_font_chooser_dialog_new + ("Pick a font", GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); + + if (default_name) + { + /* Convert fontconfig names to Gtk names, i.e. remove - before + number */ + char *p = strrchr (default_name, '-'); + if (p) + { + char *ep = p+1; + while (isdigit (*ep)) + ++ep; + if (*ep == '\0') *p = ' '; + } + } + else if (x_last_font_name) + default_name = x_last_font_name; + + if (default_name) + gtk_font_chooser_set_font (GTK_FONT_CHOOSER (w), default_name); gtk_widget_set_name (w, "emacs-fontdialog"); - done = xg_dialog_run (f, w); #if defined (HAVE_PTHREAD) && defined (__SIGRTMIN) @@ -2015,11 +2091,55 @@ xg_get_font_name (FRAME_PTR f, const char *default_name) #endif if (done == GTK_RESPONSE_OK) - fontname = gtk_font_selection_dialog_get_font_name - (GTK_FONT_SELECTION_DIALOG (w)); + { +#if USE_NEW_GTK_FONT_CHOOSER + /* Use the GTK3 font chooser. */ + PangoFontDescription *desc + = gtk_font_chooser_get_font_desc (GTK_FONT_CHOOSER (w)); + + if (desc) + { + Lisp_Object args[8]; + const char *name = pango_font_description_get_family (desc); + gint size = pango_font_description_get_size (desc); + PangoWeight weight = pango_font_description_get_weight (desc); + PangoStyle style = pango_font_description_get_style (desc); + + args[0] = QCname; + args[1] = build_string (name); + + args[2] = QCsize; + args[3] = make_float (pango_units_to_double (size)); + + args[4] = QCweight; + args[5] = XG_WEIGHT_TO_SYMBOL (weight); + + args[6] = QCslant; + args[7] = XG_STYLE_TO_SYMBOL (style); + + font = Ffont_spec (8, args); + + pango_font_description_free (desc); + xfree (x_last_font_name); + x_last_font_name = xstrdup (name); + } + +#else /* Use old font selector, which just returns the font name. */ + + char *font_name + = gtk_font_selection_dialog_get_font_name (GTK_FONT_CHOOSER (w)); + + if (font_name) + { + font = build_string (font_name); + g_free (x_last_font_name); + x_last_font_name = font_name; + } +#endif /* USE_NEW_GTK_FONT_CHOOSER */ + } gtk_widget_destroy (w); - return fontname; + return font; } #endif /* HAVE_FREETYPE */ @@ -2061,7 +2181,7 @@ make_cl_data (xg_menu_cb_data *cl_data, FRAME_PTR f, GCallback highlight_cb) { cl_data = xmalloc (sizeof *cl_data); cl_data->f = f; - cl_data->menu_bar_vector = FVAR (f, menu_bar_vector); + cl_data->menu_bar_vector = f->menu_bar_vector; cl_data->menu_bar_items_used = f->menu_bar_items_used; cl_data->highlight_cb = highlight_cb; cl_data->ref_count = 0; @@ -2093,7 +2213,7 @@ update_cl_data (xg_menu_cb_data *cl_data, if (cl_data) { cl_data->f = f; - cl_data->menu_bar_vector = FVAR (f, menu_bar_vector); + cl_data->menu_bar_vector = f->menu_bar_vector; cl_data->menu_bar_items_used = f->menu_bar_items_used; cl_data->highlight_cb = highlight_cb; } @@ -2122,6 +2242,7 @@ void xg_mark_data (void) { xg_list_node *iter; + Lisp_Object rest, frame; for (iter = xg_menu_cb_list.next; iter; iter = iter->next) mark_object (((xg_menu_cb_data *) iter)->menu_bar_vector); @@ -2133,6 +2254,23 @@ xg_mark_data (void) if (! NILP (cb_data->help)) mark_object (cb_data->help); } + + FOR_EACH_FRAME (rest, frame) + { + FRAME_PTR f = XFRAME (frame); + + if (FRAME_X_P (f) && FRAME_GTK_OUTER_WIDGET (f)) + { + struct xg_frame_tb_info *tbinfo + = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY); + if (tbinfo) + { + mark_object (tbinfo->last_tool_bar); + mark_object (tbinfo->style); + } + } + } } @@ -3810,12 +3948,12 @@ xg_tool_bar_callback (GtkWidget *w, gpointer client_data) struct input_event event; EVENT_INIT (event); - if (! f || ! f->n_tool_bar_items || NILP (FVAR (f, tool_bar_items))) + if (! f || ! f->n_tool_bar_items || NILP (f->tool_bar_items)) return; idx *= TOOL_BAR_ITEM_NSLOTS; - key = AREF (FVAR (f, tool_bar_items), idx + TOOL_BAR_ITEM_KEY); + key = AREF (f->tool_bar_items, idx + TOOL_BAR_ITEM_KEY); XSETFRAME (frame, f); /* We generate two events here. The first one is to set the prefix @@ -4086,16 +4224,16 @@ xg_tool_bar_help_callback (GtkWidget *w, FRAME_PTR f = (FRAME_PTR) g_object_get_data (G_OBJECT (w), XG_FRAME_DATA); Lisp_Object help, frame; - if (! f || ! f->n_tool_bar_items || NILP (FVAR (f, tool_bar_items))) + if (! f || ! f->n_tool_bar_items || NILP (f->tool_bar_items)) return FALSE; if (event->type == GDK_ENTER_NOTIFY) { idx *= TOOL_BAR_ITEM_NSLOTS; - help = AREF (FVAR (f, tool_bar_items), idx + TOOL_BAR_ITEM_HELP); + help = AREF (f->tool_bar_items, idx + TOOL_BAR_ITEM_HELP); if (NILP (help)) - help = AREF (FVAR (f, tool_bar_items), idx + TOOL_BAR_ITEM_CAPTION); + help = AREF (f->tool_bar_items, idx + TOOL_BAR_ITEM_CAPTION); } else help = Qnil; @@ -4208,6 +4346,21 @@ xg_create_tool_bar (FRAME_PTR f) #if GTK_CHECK_VERSION (3, 3, 6) GtkStyleContext *gsty; #endif + struct xg_frame_tb_info *tbinfo + = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY); + if (! tbinfo) + { + tbinfo = xmalloc (sizeof (*tbinfo)); + tbinfo->last_tool_bar = Qnil; + tbinfo->style = Qnil; + tbinfo->hmargin = tbinfo->vmargin = 0; + tbinfo->dir = GTK_TEXT_DIR_NONE; + tbinfo->n_last_items = 0; + g_object_set_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY, + tbinfo); + } x->toolbar_widget = gtk_toolbar_new (); x->toolbar_detached = 0; @@ -4223,7 +4376,7 @@ xg_create_tool_bar (FRAME_PTR f) } -#define PROP(IDX) AREF (FVAR (f, tool_bar_items), i * TOOL_BAR_ITEM_NSLOTS + (IDX)) +#define PROP(IDX) AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX)) /* Find the right-to-left image named by RTL in the tool bar images for F. Returns IMAGE if RTL is not found. */ @@ -4245,7 +4398,7 @@ find_rtl_image (FRAME_PTR f, Lisp_Object image, Lisp_Object rtl) { file = call1 (intern ("file-name-sans-extension"), Ffile_name_nondirectory (file)); - if (EQ (Fequal (file, rtl_name), Qt)) + if (! NILP (Fequal (file, rtl_name))) { image = rtl_image; break; @@ -4478,6 +4631,7 @@ update_frame_tool_bar (FRAME_PTR f) int pack_tool_bar = x->handlebox_widget == NULL; Lisp_Object style; int text_image, horiz; + struct xg_frame_tb_info *tbinfo; if (! FRAME_GTK_WIDGET (f)) return; @@ -4512,6 +4666,29 @@ update_frame_tool_bar (FRAME_PTR f) dir = gtk_widget_get_direction (GTK_WIDGET (wtoolbar)); style = Ftool_bar_get_system_style (); + + /* Are we up to date? */ + tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY); + + if (! NILP (tbinfo->last_tool_bar) && ! NILP (f->tool_bar_items) + && tbinfo->n_last_items == f->n_tool_bar_items + && tbinfo->hmargin == hmargin && tbinfo->vmargin == vmargin + && tbinfo->dir == dir + && ! NILP (Fequal (tbinfo->style, style)) + && ! NILP (Fequal (tbinfo->last_tool_bar, f->tool_bar_items))) + { + UNBLOCK_INPUT; + return; + } + + tbinfo->last_tool_bar = f->tool_bar_items; + tbinfo->n_last_items = f->n_tool_bar_items; + tbinfo->style = style; + tbinfo->hmargin = hmargin; + tbinfo->vmargin = vmargin; + tbinfo->dir = dir; + text_image = EQ (style, Qtext_image_horiz); horiz = EQ (style, Qboth_horiz) || text_image; @@ -4706,7 +4883,7 @@ update_frame_tool_bar (FRAME_PTR f) if (f->n_tool_bar_items != 0) { if (pack_tool_bar) - xg_pack_tool_bar (f, FVAR (f, tool_bar_position)); + xg_pack_tool_bar (f, f->tool_bar_position); gtk_widget_show_all (GTK_WIDGET (x->handlebox_widget)); if (xg_update_tool_bar_sizes (f)) xg_height_or_width_changed (f); @@ -4725,6 +4902,7 @@ free_frame_tool_bar (FRAME_PTR f) if (x->toolbar_widget) { + struct xg_frame_tb_info *tbinfo; int is_packed = x->handlebox_widget != 0; BLOCK_INPUT; /* We may have created the toolbar_widget in xg_create_tool_bar, but @@ -4746,6 +4924,16 @@ free_frame_tool_bar (FRAME_PTR f) FRAME_TOOLBAR_TOP_HEIGHT (f) = FRAME_TOOLBAR_BOTTOM_HEIGHT (f) = 0; FRAME_TOOLBAR_LEFT_WIDTH (f) = FRAME_TOOLBAR_RIGHT_WIDTH (f) = 0; + tbinfo = g_object_get_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY); + if (tbinfo) + { + xfree (tbinfo); + g_object_set_data (G_OBJECT (FRAME_GTK_OUTER_WIDGET (f)), + TB_INFO_KEY, + NULL); + } + xg_height_or_width_changed (f); UNBLOCK_INPUT; @@ -4832,6 +5020,8 @@ xg_initialize (void) gtk_binding_entry_add_signal (binding_set, GDK_KEY_g, GDK_CONTROL_MASK, "cancel", 0); update_theme_scrollbar_width (); + + x_last_font_name = NULL; } #endif /* USE_GTK */ diff --git a/src/gtkutil.h b/src/gtkutil.h index 94c1a1d96ad..462e879d3e7 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -86,7 +86,7 @@ extern char *xg_get_file_name (FRAME_PTR f, int mustmatch_p, int only_dir_p); -extern char *xg_get_font_name (FRAME_PTR f, const char *); +extern Lisp_Object xg_get_font (FRAME_PTR f, const char *); extern GtkWidget *xg_create_widget (const char *type, const char *name, diff --git a/src/indent.c b/src/indent.c index a6a9a9a0073..881e5d7ddaf 100644 --- a/src/indent.c +++ b/src/indent.c @@ -141,7 +141,7 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab) struct Lisp_Vector *widthtab; if (!VECTORP (BVAR (buf, width_table))) - BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); + BSET (buf, width_table, Fmake_vector (make_number (256), make_number (0))); widthtab = XVECTOR (BVAR (buf, width_table)); if (widthtab->header.size != 256) abort (); @@ -166,7 +166,7 @@ width_run_cache_on_off (void) { free_region_cache (current_buffer->width_run_cache); current_buffer->width_run_cache = 0; - BVAR (current_buffer, width_table) = Qnil; + BSET (current_buffer, width_table, Qnil); } } else @@ -258,7 +258,7 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p, ptrdiff_t to, Lisp_Ob the next property change */ prop = Fget_char_property (position, Qinvisible, (!NILP (window) - && EQ (WVAR (XWINDOW (window), buffer), buffer)) + && EQ (XWINDOW (window)->buffer, buffer)) ? window : buffer); inv_p = TEXT_PROP_MEANS_INVISIBLE (prop); /* When counting columns (window == nil), don't skip over ellipsis text. */ @@ -336,9 +336,8 @@ current_column (void) /* If the buffer has overlays, text properties, or multibyte characters, use a more general algorithm. */ - if (BUF_INTERVALS (current_buffer) - || current_buffer->overlays_before - || current_buffer->overlays_after + if (buffer_get_intervals (current_buffer) + || buffer_has_overlays () || Z != Z_BYTE) return current_column_1 (); @@ -1173,14 +1172,14 @@ compute_motion (ptrdiff_t from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ width = window_body_cols (win); /* We must make room for continuation marks if we don't have fringes. */ #ifdef HAVE_WINDOW_SYSTEM - if (!FRAME_WINDOW_P (XFRAME (WVAR (win, frame)))) + if (!FRAME_WINDOW_P (XFRAME (win->frame))) #endif width -= 1; } continuation_glyph_width = 1; #ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (XFRAME (WVAR (win, frame)))) + if (FRAME_WINDOW_P (XFRAME (win->frame))) continuation_glyph_width = 0; /* In the fringe. */ #endif @@ -1787,7 +1786,7 @@ visible section of the buffer, and pass LINE and COL as TOPOS. */) ? (window_body_cols (w) - ( #ifdef HAVE_WINDOW_SYSTEM - FRAME_WINDOW_P (XFRAME (WVAR (w, frame))) ? 0 : + FRAME_WINDOW_P (XFRAME (w->frame)) ? 0 : #endif 1)) : XINT (XCAR (topos))), @@ -1837,7 +1836,7 @@ vmotion (register ptrdiff_t from, register EMACS_INT vtarget, struct window *w) /* If the window contains this buffer, use it for getting text properties. Otherwise use the current buffer as arg for doing that. */ - if (EQ (WVAR (w, buffer), Fcurrent_buffer ())) + if (EQ (w->buffer, Fcurrent_buffer ())) text_prop_object = window; else text_prop_object = Fcurrent_buffer (); @@ -1998,14 +1997,14 @@ whether or not it is currently displayed in some window. */) old_buffer = Qnil; GCPRO3 (old_buffer, old_charpos, old_bytepos); - if (XBUFFER (WVAR (w, buffer)) != current_buffer) + if (XBUFFER (w->buffer) != current_buffer) { /* Set the window's buffer temporarily to the current buffer. */ - old_buffer = WVAR (w, buffer); - old_charpos = XMARKER (WVAR (w, pointm))->charpos; - old_bytepos = XMARKER (WVAR (w, pointm))->bytepos; - XSETBUFFER (WVAR (w, buffer), current_buffer); - set_marker_both (WVAR (w, pointm), WVAR (w, buffer), + old_buffer = w->buffer; + old_charpos = XMARKER (w->pointm)->charpos; + old_bytepos = XMARKER (w->pointm)->bytepos; + WSET (w, buffer, Fcurrent_buffer ()); + set_marker_both (w->pointm, w->buffer, BUF_PT (current_buffer), BUF_PT_BYTE (current_buffer)); } @@ -2137,7 +2136,7 @@ whether or not it is currently displayed in some window. */) } move_it_in_display_line (&it, ZV, - (int)(cols * FRAME_COLUMN_WIDTH (XFRAME (WVAR (w, frame))) + 0.5), + (int)(cols * FRAME_COLUMN_WIDTH (XFRAME (w->frame)) + 0.5), MOVE_TO_X); } @@ -2147,8 +2146,8 @@ whether or not it is currently displayed in some window. */) if (BUFFERP (old_buffer)) { - WVAR (w, buffer) = old_buffer; - set_marker_both (WVAR (w, pointm), WVAR (w, buffer), + WSET (w, buffer, old_buffer); + set_marker_both (w->pointm, w->buffer, old_charpos, old_bytepos); } diff --git a/src/insdel.c b/src/insdel.c index 705cd77dc0d..14d2dab084d 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -844,10 +844,10 @@ insert_1_both (const char *string, PT + nchars, PT_BYTE + nbytes, before_markers); - if (BUF_INTERVALS (current_buffer) != 0) + if (buffer_get_intervals (current_buffer)) offset_intervals (current_buffer, PT, nchars); - if (!inherit && BUF_INTERVALS (current_buffer) != 0) + if (!inherit && buffer_get_intervals (current_buffer)) set_text_properties (make_number (PT), make_number (PT + nchars), Qnil, Qnil, Qnil); @@ -976,7 +976,7 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos, ptrdiff_t pos_byte, offset_intervals (current_buffer, PT, nchars); - intervals = STRING_INTERVALS (string); + intervals = string_get_intervals (string); /* Get the intervals for the part of the string we are inserting. */ if (nbytes < SBYTES (string)) intervals = copy_intervals (intervals, pos, nchars); @@ -1017,10 +1017,10 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes) adjust_markers_for_insert (GPT - nchars, GPT_BYTE - nbytes, GPT, GPT_BYTE, 0); - if (BUF_INTERVALS (current_buffer) != 0) + if (buffer_get_intervals (current_buffer)) { offset_intervals (current_buffer, GPT - nchars, nchars); - graft_intervals_into_buffer (NULL_INTERVAL, GPT - nchars, nchars, + graft_intervals_into_buffer (NULL, GPT - nchars, nchars, current_buffer, 0); } @@ -1157,11 +1157,11 @@ insert_from_buffer_1 (struct buffer *buf, PT_BYTE + outgoing_nbytes, 0); - if (BUF_INTERVALS (current_buffer) != 0) + if (buffer_get_intervals (current_buffer)) offset_intervals (current_buffer, PT, nchars); /* Get the intervals for the part of the string we are inserting. */ - intervals = BUF_INTERVALS (buf); + intervals = buffer_get_intervals (buf); if (nchars < BUF_Z (buf) - BUF_BEG (buf)) { if (buf == current_buffer && PT <= from) @@ -1225,10 +1225,9 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte, adjust_overlays_for_insert (from, len - nchars_del); else if (len < nchars_del) adjust_overlays_for_delete (from, nchars_del - len); - if (BUF_INTERVALS (current_buffer) != 0) - { - offset_intervals (current_buffer, from, len - nchars_del); - } + + if (buffer_get_intervals (current_buffer)) + offset_intervals (current_buffer, from, len - nchars_del); if (from < PT) adjust_point (len - nchars_del, len_byte - nbytes_del); @@ -1413,7 +1412,7 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object new, /* Get the intervals for the part of the string we are inserting-- not including the combined-before bytes. */ - intervals = STRING_INTERVALS (new); + intervals = string_get_intervals (new); /* Insert those intervals. */ graft_intervals_into_buffer (intervals, from, inschars, current_buffer, inherit); @@ -1793,7 +1792,7 @@ modify_region (struct buffer *buffer, ptrdiff_t start, ptrdiff_t end, if (! preserve_chars_modiff) CHARS_MODIFF = MODIFF; - BVAR (buffer, point_before_scroll) = Qnil; + BSET (buffer, point_before_scroll, Qnil); if (buffer != old_buffer) set_buffer_internal (old_buffer); @@ -1820,10 +1819,10 @@ prepare_to_modify_buffer (ptrdiff_t start, ptrdiff_t end, /* Let redisplay consider other windows than selected_window if modifying another buffer. */ - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) != current_buffer) + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) ++windows_or_buffers_changed; - if (BUF_INTERVALS (current_buffer) != 0) + if (buffer_get_intervals (current_buffer)) { if (preserve_ptr) { @@ -1994,7 +1993,7 @@ signal_before_change (ptrdiff_t start_int, ptrdiff_t end_int, XSETCDR (rvoe_arg, Qt); } - if (current_buffer->overlays_before || current_buffer->overlays_after) + if (buffer_has_overlays ()) { PRESERVE_VALUE; report_overlay_modification (FETCH_START, FETCH_END, 0, @@ -2030,8 +2029,7 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) just record the args that we were going to use. */ if (! NILP (Vcombine_after_change_calls) && NILP (Vbefore_change_functions) - && !current_buffer->overlays_before - && !current_buffer->overlays_after) + && !buffer_has_overlays ()) { Lisp_Object elt; @@ -2073,7 +2071,7 @@ signal_after_change (ptrdiff_t charpos, ptrdiff_t lendel, ptrdiff_t lenins) XSETCDR (rvoe_arg, Qt); } - if (current_buffer->overlays_before || current_buffer->overlays_after) + if (buffer_has_overlays ()) report_overlay_modification (make_number (charpos), make_number (charpos + lenins), 1, diff --git a/src/intervals.c b/src/intervals.c index cd1254b5e46..09949bbbd45 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -38,6 +38,9 @@ along with GNU Emacs. If not, see . */ #include + +#define INTERVALS_INLINE EXTERN_INLINE + #include #include #include "lisp.h" @@ -76,19 +79,19 @@ create_root_interval (Lisp_Object parent) { new->total_length = (BUF_Z (XBUFFER (parent)) - BUF_BEG (XBUFFER (parent))); - CHECK_TOTAL_LENGTH (new); - BUF_INTERVALS (XBUFFER (parent)) = new; + eassert (0 <= TOTAL_LENGTH (new)); + buffer_set_intervals (XBUFFER (parent), new); new->position = BEG; } else if (STRINGP (parent)) { new->total_length = SCHARS (parent); - CHECK_TOTAL_LENGTH (new); - STRING_SET_INTERVALS (parent, new); + eassert (0 <= TOTAL_LENGTH (new)); + string_set_intervals (parent, new); new->position = 0; } - SET_INTERVAL_OBJECT (new, parent); + interval_set_object (new, parent); return new; } @@ -102,7 +105,7 @@ copy_properties (register INTERVAL source, register INTERVAL target) return; COPY_INTERVAL_CACHE (source, target); - target->plist = Fcopy_sequence (source->plist); + interval_set_plist (target, Fcopy_sequence (source->plist)); } /* Merge the properties of interval SOURCE into the properties @@ -138,7 +141,7 @@ merge_properties (register INTERVAL source, register INTERVAL target) if (NILP (val)) { val = XCAR (o); - target->plist = Fcons (sym, Fcons (val, target->plist)); + interval_set_plist (target, Fcons (sym, Fcons (val, target->plist))); } o = XCDR (o); } @@ -207,10 +210,10 @@ void traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) { /* Minimize stack usage. */ - while (!NULL_INTERVAL_P (tree)) + while (tree) { (*function) (tree, arg); - if (NULL_INTERVAL_P (tree->right)) + if (!tree->right) tree = tree->left; else { @@ -227,7 +230,7 @@ void traverse_intervals (INTERVAL tree, ptrdiff_t position, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) { - while (!NULL_INTERVAL_P (tree)) + while (tree) { traverse_intervals (tree->left, position, function, arg); position += LEFT_TOTAL_LENGTH (tree); @@ -262,7 +265,7 @@ search_for_interval (INTERVAL i, INTERVAL tree) { icount = 0; search_interval = i; - found_interval = NULL_INTERVAL; + found_interval = NULL; traverse_intervals_noorder (tree, &check_for_interval, Qnil); return found_interval; } @@ -320,29 +323,29 @@ rotate_right (INTERVAL interval) if (! ROOT_INTERVAL_P (interval)) { if (AM_LEFT_CHILD (interval)) - INTERVAL_PARENT (interval)->left = B; + interval_set_left (INTERVAL_PARENT (interval), B); else - INTERVAL_PARENT (interval)->right = B; + interval_set_right (INTERVAL_PARENT (interval), B); } - COPY_INTERVAL_PARENT (B, interval); + interval_copy_parent (B, interval); /* Make B the parent of A */ i = B->right; - B->right = interval; - SET_INTERVAL_PARENT (interval, B); + interval_set_right (B, interval); + interval_set_parent (interval, B); /* Make A point to c */ - interval->left = i; - if (! NULL_INTERVAL_P (i)) - SET_INTERVAL_PARENT (i, interval); + interval_set_left (interval, i); + if (i) + interval_set_parent (i, interval); /* A's total length is decreased by the length of B and its left child. */ interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval); - CHECK_TOTAL_LENGTH (interval); + eassert (0 <= TOTAL_LENGTH (interval)); /* B must have the same total length of A. */ B->total_length = old_total; - CHECK_TOTAL_LENGTH (B); + eassert (0 <= TOTAL_LENGTH (B)); return B; } @@ -367,29 +370,29 @@ rotate_left (INTERVAL interval) if (! ROOT_INTERVAL_P (interval)) { if (AM_LEFT_CHILD (interval)) - INTERVAL_PARENT (interval)->left = B; + interval_set_left (INTERVAL_PARENT (interval), B); else - INTERVAL_PARENT (interval)->right = B; + interval_set_right (INTERVAL_PARENT (interval), B); } - COPY_INTERVAL_PARENT (B, interval); + interval_copy_parent (B, interval); /* Make B the parent of A */ i = B->left; - B->left = interval; - SET_INTERVAL_PARENT (interval, B); + interval_set_left (B, interval); + interval_set_parent (interval, B); /* Make A point to c */ - interval->right = i; - if (! NULL_INTERVAL_P (i)) - SET_INTERVAL_PARENT (i, interval); + interval_set_right (interval, i); + if (i) + interval_set_parent (i, interval); /* A's total length is decreased by the length of B and its right child. */ interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval); - CHECK_TOTAL_LENGTH (interval); + eassert (0 <= TOTAL_LENGTH (interval)); /* B must have the same total length of A. */ B->total_length = old_total; - CHECK_TOTAL_LENGTH (B); + eassert (0 <= TOTAL_LENGTH (B)); return B; } @@ -453,9 +456,9 @@ balance_possible_root_interval (register INTERVAL interval) if (have_parent) { if (BUFFERP (parent)) - BUF_INTERVALS (XBUFFER (parent)) = interval; + buffer_set_intervals (XBUFFER (parent), interval); else if (STRINGP (parent)) - STRING_SET_INTERVALS (parent, interval); + string_set_intervals (parent, interval); } return interval; @@ -480,12 +483,22 @@ balance_intervals_internal (register INTERVAL tree) INTERVAL balance_intervals (INTERVAL tree) { - if (tree == NULL_INTERVAL) - return NULL_INTERVAL; - - return balance_intervals_internal (tree); + return tree ? balance_intervals_internal (tree) : NULL; } - + +/* Rebalance text properties of B. */ + +static void +buffer_balance_intervals (struct buffer *b) +{ + INTERVAL i; + + eassert (b != NULL); + i = buffer_get_intervals (b); + if (i) + buffer_set_intervals (b, balance_an_interval (i)); +} + /* Split INTERVAL into two pieces, starting the second piece at character position OFFSET (counting from 0), relative to INTERVAL. INTERVAL becomes the left-hand piece, and the right-hand piece @@ -507,22 +520,22 @@ split_interval_right (INTERVAL interval, ptrdiff_t offset) ptrdiff_t new_length = LENGTH (interval) - offset; new->position = position + offset; - SET_INTERVAL_PARENT (new, interval); + interval_set_parent (new, interval); if (NULL_RIGHT_CHILD (interval)) { - interval->right = new; + interval_set_right (interval, new); new->total_length = new_length; - CHECK_TOTAL_LENGTH (new); + eassert (0 <= TOTAL_LENGTH (new)); } else { /* Insert the new node between INTERVAL and its right child. */ - new->right = interval->right; - SET_INTERVAL_PARENT (interval->right, new); - interval->right = new; + interval_set_right (new, interval->right); + interval_set_parent (interval->right, new); + interval_set_right (interval, new); new->total_length = new_length + new->right->total_length; - CHECK_TOTAL_LENGTH (new); + eassert (0 <= TOTAL_LENGTH (new)); balance_an_interval (new); } @@ -552,22 +565,22 @@ split_interval_left (INTERVAL interval, ptrdiff_t offset) new->position = interval->position; interval->position = interval->position + offset; - SET_INTERVAL_PARENT (new, interval); + interval_set_parent (new, interval); if (NULL_LEFT_CHILD (interval)) { - interval->left = new; + interval_set_left (interval, new); new->total_length = new_length; - CHECK_TOTAL_LENGTH (new); + eassert (0 <= TOTAL_LENGTH (new)); } else { /* Insert the new node between INTERVAL and its left child. */ - new->left = interval->left; - SET_INTERVAL_PARENT (new->left, new); - interval->left = new; + interval_set_left (new, interval->left); + interval_set_parent (new->left, new); + interval_set_left (interval, new); new->total_length = new_length + new->left->total_length; - CHECK_TOTAL_LENGTH (new); + eassert (0 <= TOTAL_LENGTH (new)); balance_an_interval (new); } @@ -589,7 +602,7 @@ interval_start_pos (INTERVAL source) { Lisp_Object parent; - if (NULL_INTERVAL_P (source)) + if (!source) return 0; if (! INTERVAL_HAS_OBJECT (source)) @@ -617,8 +630,8 @@ find_interval (register INTERVAL tree, register ptrdiff_t position) to POSITION. */ register ptrdiff_t relative_position; - if (NULL_INTERVAL_P (tree)) - return NULL_INTERVAL; + if (!tree) + return NULL; relative_position = position; if (INTERVAL_HAS_OBJECT (tree)) @@ -669,8 +682,8 @@ next_interval (register INTERVAL interval) register INTERVAL i = interval; register ptrdiff_t next_position; - if (NULL_INTERVAL_P (i)) - return NULL_INTERVAL; + if (!i) + return NULL; next_position = interval->position + LENGTH (interval); if (! NULL_RIGHT_CHILD (i)) @@ -695,7 +708,7 @@ next_interval (register INTERVAL interval) i = INTERVAL_PARENT (i); } - return NULL_INTERVAL; + return NULL; } /* Find the preceding interval (lexicographically) to INTERVAL. @@ -707,8 +720,8 @@ previous_interval (register INTERVAL interval) { register INTERVAL i; - if (NULL_INTERVAL_P (interval)) - return NULL_INTERVAL; + if (!interval) + return NULL; if (! NULL_LEFT_CHILD (interval)) { @@ -733,7 +746,7 @@ previous_interval (register INTERVAL interval) i = INTERVAL_PARENT (i); } - return NULL_INTERVAL; + return NULL; } /* Find the interval containing POS given some non-NULL INTERVAL @@ -744,8 +757,8 @@ previous_interval (register INTERVAL interval) INTERVAL update_interval (register INTERVAL i, ptrdiff_t pos) { - if (NULL_INTERVAL_P (i)) - return NULL_INTERVAL; + if (!i) + return NULL; while (1) { @@ -918,7 +931,7 @@ adjust_intervals_for_insertion (INTERVAL tree, for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp)) { temp->total_length += length; - CHECK_TOTAL_LENGTH (temp); + eassert (0 <= TOTAL_LENGTH (temp)); temp = balance_possible_root_interval (temp); } @@ -938,25 +951,23 @@ adjust_intervals_for_insertion (INTERVAL tree, struct interval newi; RESET_INTERVAL (&newi); - pleft = NULL_INTERVAL_P (prev) ? Qnil : prev->plist; - pright = NULL_INTERVAL_P (i) ? Qnil : i->plist; - newi.plist = merge_properties_sticky (pleft, pright); + pleft = prev ? prev->plist : Qnil; + pright = i ? i->plist : Qnil; + interval_set_plist (&newi, merge_properties_sticky (pleft, pright)); if (! prev) /* i.e. position == BEG */ { if (! intervals_equal (i, &newi)) { i = split_interval_left (i, length); - i->plist = newi.plist; + interval_set_plist (i, newi.plist); } } else if (! intervals_equal (prev, &newi)) { - prev = split_interval_right (prev, - position - prev->position); - prev->plist = newi.plist; - if (! NULL_INTERVAL_P (i) - && intervals_equal (prev, i)) + prev = split_interval_right (prev, position - prev->position); + interval_set_plist (prev, newi.plist); + if (i && intervals_equal (prev, i)) merge_interval_right (prev); } @@ -976,7 +987,7 @@ adjust_intervals_for_insertion (INTERVAL tree, for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp)) { temp->total_length += length; - CHECK_TOTAL_LENGTH (temp); + eassert (0 <= TOTAL_LENGTH (temp)); temp = balance_possible_root_interval (temp); } } @@ -1165,23 +1176,23 @@ delete_node (register INTERVAL i) register INTERVAL migrate, this; register ptrdiff_t migrate_amt; - if (NULL_INTERVAL_P (i->left)) + if (!i->left) return i->right; - if (NULL_INTERVAL_P (i->right)) + if (!i->right) return i->left; migrate = i->left; migrate_amt = i->left->total_length; this = i->right; this->total_length += migrate_amt; - while (! NULL_INTERVAL_P (this->left)) + while (this->left) { this = this->left; this->total_length += migrate_amt; } - CHECK_TOTAL_LENGTH (this); - this->left = migrate; - SET_INTERVAL_PARENT (migrate, this); + eassert (0 <= TOTAL_LENGTH (this)); + interval_set_left (this, migrate); + interval_set_parent (migrate, this); return i->right; } @@ -1205,13 +1216,13 @@ delete_interval (register INTERVAL i) Lisp_Object owner; GET_INTERVAL_OBJECT (owner, i); parent = delete_node (i); - if (! NULL_INTERVAL_P (parent)) - SET_INTERVAL_OBJECT (parent, owner); + if (parent) + interval_set_object (parent, owner); if (BUFFERP (owner)) - BUF_INTERVALS (XBUFFER (owner)) = parent; + buffer_set_intervals (XBUFFER (owner), parent); else if (STRINGP (owner)) - STRING_SET_INTERVALS (owner, parent); + string_set_intervals (owner, parent); else abort (); @@ -1221,15 +1232,15 @@ delete_interval (register INTERVAL i) parent = INTERVAL_PARENT (i); if (AM_LEFT_CHILD (i)) { - parent->left = delete_node (i); - if (! NULL_INTERVAL_P (parent->left)) - SET_INTERVAL_PARENT (parent->left, parent); + interval_set_left (parent, delete_node (i)); + if (parent->left) + interval_set_parent (parent->left, parent); } else { - parent->right = delete_node (i); - if (! NULL_INTERVAL_P (parent->right)) - SET_INTERVAL_PARENT (parent->right, parent); + interval_set_right (parent, delete_node (i)); + if (parent->right) + interval_set_parent (parent->right, parent); } } @@ -1251,7 +1262,7 @@ interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from, { register ptrdiff_t relative_position = from; - if (NULL_INTERVAL_P (tree)) + if (!tree) return 0; /* Left branch. */ @@ -1261,7 +1272,7 @@ interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from, relative_position, amount); tree->total_length -= subtract; - CHECK_TOTAL_LENGTH (tree); + eassert (0 <= TOTAL_LENGTH (tree)); return subtract; } /* Right branch. */ @@ -1276,7 +1287,7 @@ interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from, relative_position, amount); tree->total_length -= subtract; - CHECK_TOTAL_LENGTH (tree); + eassert (0 <= TOTAL_LENGTH (tree)); return subtract; } /* Here -- this node. */ @@ -1291,7 +1302,7 @@ interval_deletion_adjustment (register INTERVAL tree, register ptrdiff_t from, amount = my_amount; tree->total_length -= amount; - CHECK_TOTAL_LENGTH (tree); + eassert (0 <= TOTAL_LENGTH (tree)); if (LENGTH (tree) == 0) delete_interval (tree); @@ -1311,14 +1322,14 @@ adjust_intervals_for_deletion (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length) { register ptrdiff_t left_to_delete = length; - register INTERVAL tree = BUF_INTERVALS (buffer); + register INTERVAL tree = buffer_get_intervals (buffer); Lisp_Object parent; ptrdiff_t offset; GET_INTERVAL_OBJECT (parent, tree); offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0); - if (NULL_INTERVAL_P (tree)) + if (!tree) return; eassert (start <= offset + TOTAL_LENGTH (tree) @@ -1326,14 +1337,14 @@ adjust_intervals_for_deletion (struct buffer *buffer, if (length == TOTAL_LENGTH (tree)) { - BUF_INTERVALS (buffer) = NULL_INTERVAL; + buffer_set_intervals (buffer, NULL); return; } if (ONLY_INTERVAL_P (tree)) { tree->total_length -= length; - CHECK_TOTAL_LENGTH (tree); + eassert (0 <= TOTAL_LENGTH (tree)); return; } @@ -1343,10 +1354,10 @@ adjust_intervals_for_deletion (struct buffer *buffer, { left_to_delete -= interval_deletion_adjustment (tree, start - offset, left_to_delete); - tree = BUF_INTERVALS (buffer); + tree = buffer_get_intervals (buffer); if (left_to_delete == tree->total_length) { - BUF_INTERVALS (buffer) = NULL_INTERVAL; + buffer_set_intervals (buffer, NULL); return; } } @@ -1355,20 +1366,17 @@ adjust_intervals_for_deletion (struct buffer *buffer, /* Make the adjustments necessary to the interval tree of BUFFER to represent an addition or deletion of LENGTH characters starting at position START. Addition or deletion is indicated by the sign - of LENGTH. - - The two inline functions (one static) pacify Sun C 5.8, a pre-C99 - compiler that does not allow calling a static function (here, - adjust_intervals_for_deletion) from a non-static inline function. */ + of LENGTH. */ void offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length) { - if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0) + if (!buffer_get_intervals (buffer) || length == 0) return; if (length > 0) - adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length); + adjust_intervals_for_insertion (buffer_get_intervals (buffer), + start, length); else { IF_LINT (if (length < - TYPE_MAXIMUM (ptrdiff_t)) abort ();) @@ -1399,19 +1407,19 @@ merge_interval_right (register INTERVAL i) while (! NULL_LEFT_CHILD (successor)) { successor->total_length += absorb; - CHECK_TOTAL_LENGTH (successor); + eassert (0 <= TOTAL_LENGTH (successor)); successor = successor->left; } successor->total_length += absorb; - CHECK_TOTAL_LENGTH (successor); + eassert (0 <= TOTAL_LENGTH (successor)); delete_interval (i); return successor; } /* Zero out this interval. */ i->total_length -= absorb; - CHECK_TOTAL_LENGTH (i); + eassert (0 <= TOTAL_LENGTH (i)); successor = i; while (! NULL_PARENT (successor)) /* It's above us. Subtract as @@ -1426,7 +1434,7 @@ merge_interval_right (register INTERVAL i) successor = INTERVAL_PARENT (successor); successor->total_length -= absorb; - CHECK_TOTAL_LENGTH (successor); + eassert (0 <= TOTAL_LENGTH (successor)); } /* This must be the rightmost or last interval and cannot @@ -1455,19 +1463,19 @@ merge_interval_left (register INTERVAL i) while (! NULL_RIGHT_CHILD (predecessor)) { predecessor->total_length += absorb; - CHECK_TOTAL_LENGTH (predecessor); + eassert (0 <= TOTAL_LENGTH (predecessor)); predecessor = predecessor->right; } predecessor->total_length += absorb; - CHECK_TOTAL_LENGTH (predecessor); + eassert (0 <= TOTAL_LENGTH (predecessor)); delete_interval (i); return predecessor; } /* Zero out this interval. */ i->total_length -= absorb; - CHECK_TOTAL_LENGTH (i); + eassert (0 <= TOTAL_LENGTH (i)); predecessor = i; while (! NULL_PARENT (predecessor)) /* It's above us. Go up, @@ -1482,7 +1490,7 @@ merge_interval_left (register INTERVAL i) predecessor = INTERVAL_PARENT (predecessor); predecessor->total_length -= absorb; - CHECK_TOTAL_LENGTH (predecessor); + eassert (0 <= TOTAL_LENGTH (predecessor)); } /* This must be the leftmost or first interval and cannot @@ -1500,13 +1508,13 @@ reproduce_tree (INTERVAL source, INTERVAL parent) { register INTERVAL t = make_interval (); - memcpy (t, source, INTERVAL_SIZE); + memcpy (t, source, sizeof *t); copy_properties (source, t); - SET_INTERVAL_PARENT (t, parent); + interval_set_parent (t, parent); if (! NULL_LEFT_CHILD (source)) - t->left = reproduce_tree (source->left, t); + interval_set_left (t, reproduce_tree (source->left, t)); if (! NULL_RIGHT_CHILD (source)) - t->right = reproduce_tree (source->right, t); + interval_set_right (t, reproduce_tree (source->right, t)); return t; } @@ -1516,13 +1524,13 @@ reproduce_tree_obj (INTERVAL source, Lisp_Object parent) { register INTERVAL t = make_interval (); - memcpy (t, source, INTERVAL_SIZE); + memcpy (t, source, sizeof *t); copy_properties (source, t); - SET_INTERVAL_OBJECT (t, parent); + interval_set_object (t, parent); if (! NULL_LEFT_CHILD (source)) - t->left = reproduce_tree (source->left, t); + interval_set_left (t, reproduce_tree (source->left, t)); if (! NULL_RIGHT_CHILD (source)) - t->right = reproduce_tree (source->right, t); + interval_set_right (t, reproduce_tree (source->right, t)); return t; } @@ -1550,11 +1558,9 @@ reproduce_tree_obj (INTERVAL source, Lisp_Object parent) cases -- either insertion happened in the middle of some interval, or between two intervals. - If the text goes into the middle of an interval, then new - intervals are created in the middle with only the properties of - the new text, *unless* the macro MERGE_INSERTIONS is true, in - which case the new text has the union of its properties and those - of the text into which it was inserted. + If the text goes into the middle of an interval, then new intervals + are created in the middle, and new text has the union of its properties + and those of the text into which it was inserted. If the text goes between two intervals, then if neither interval had its appropriate sticky property set (front_sticky, rear_sticky), @@ -1575,53 +1581,56 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position, register INTERVAL tree; ptrdiff_t over_used; - tree = BUF_INTERVALS (buffer); + tree = buffer_get_intervals (buffer); /* If the new text has no properties, then with inheritance it becomes part of whatever interval it was inserted into. To prevent inheritance, we must clear out the properties of the newly inserted text. */ - if (NULL_INTERVAL_P (source)) + if (!source) { Lisp_Object buf; - if (!inherit && !NULL_INTERVAL_P (tree) && length > 0) + if (!inherit && tree && length > 0) { XSETBUFFER (buf, buffer); set_text_properties_1 (make_number (position), make_number (position + length), Qnil, buf, 0); } - if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer))) - /* Shouldn't be necessary. --Stef */ - BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer)); + /* Shouldn't be necessary. --Stef */ + buffer_balance_intervals (buffer); return; } eassert (length == TOTAL_LENGTH (source)); if ((BUF_Z (buffer) - BUF_BEG (buffer)) == length) - { /* The inserted text constitutes the whole buffer, so + { + /* The inserted text constitutes the whole buffer, so simply copy over the interval structure. */ - Lisp_Object buf; - XSETBUFFER (buf, buffer); - BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf); - BUF_INTERVALS (buffer)->position = BUF_BEG (buffer); - eassert (BUF_INTERVALS (buffer)->up_obj == 1); - return; - } - else if (NULL_INTERVAL_P (tree)) - { /* Create an interval tree in which to place a copy + Lisp_Object buf; + + XSETBUFFER (buf, buffer); + buffer_set_intervals (buffer, reproduce_tree_obj (source, buf)); + buffer_get_intervals (buffer)->position = BUF_BEG (buffer); + eassert (buffer_get_intervals (buffer)->up_obj == 1); + return; + } + else if (!tree) + { + /* Create an interval tree in which to place a copy of the intervals of the inserted string. */ Lisp_Object buf; + XSETBUFFER (buf, buffer); tree = create_root_interval (buf); - } + } /* Paranoia -- the text has already been added, so this buffer should be of non-zero length. */ eassert (TOTAL_LENGTH (tree) > 0); this = under = find_interval (tree, position); - eassert (!NULL_INTERVAL_P (under)); + eassert (under); over = find_interval (source, interval_start_pos (source)); /* Here for insertion in the middle of an interval. @@ -1663,7 +1672,7 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position, have already been copied into target intervals. UNDER is the next interval in the target. */ over_used = 0; - while (! NULL_INTERVAL_P (over)) + while (over) { /* If UNDER is longer than OVER, split it. */ if (LENGTH (over) - over_used < LENGTH (under)) @@ -1696,9 +1705,7 @@ graft_intervals_into_buffer (INTERVAL source, ptrdiff_t position, under = next_interval (this); } - if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer))) - BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer)); - return; + buffer_balance_intervals (buffer); } /* Get the value of property PROP from PLIST, @@ -1847,7 +1854,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) int have_overlays; ptrdiff_t original_position; - BVAR (current_buffer, point_before_scroll) = Qnil; + BSET (current_buffer, point_before_scroll, Qnil); if (charpos == PT) return; @@ -1860,12 +1867,11 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) whether or not there are intervals in the buffer. */ eassert (charpos <= ZV && charpos >= BEGV); - have_overlays = (current_buffer->overlays_before - || current_buffer->overlays_after); + have_overlays = buffer_has_overlays (); /* If we have no text properties and overlays, then we can do it quickly. */ - if (NULL_INTERVAL_P (BUF_INTERVALS (current_buffer)) && ! have_overlays) + if (!buffer_get_intervals (current_buffer) && ! have_overlays) { temp_set_point_both (current_buffer, charpos, bytepos); return; @@ -1874,7 +1880,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) /* Set TO to the interval containing the char after CHARPOS, and TOPREV to the interval containing the char before CHARPOS. Either one may be null. They may be equal. */ - to = find_interval (BUF_INTERVALS (current_buffer), charpos); + to = find_interval (buffer_get_intervals (current_buffer), charpos); if (charpos == BEGV) toprev = 0; else if (to && to->position == charpos) @@ -1888,7 +1894,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) and FROMPREV to the interval containing the char before PT. Either one may be null. They may be equal. */ /* We could cache this and save time. */ - from = find_interval (BUF_INTERVALS (current_buffer), buffer_point); + from = find_interval (buffer_get_intervals (current_buffer), buffer_point); if (buffer_point == BEGV) fromprev = 0; else if (from && from->position == PT) @@ -1912,7 +1918,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) with the same intangible property value, move forward or backward until a change in that property. */ if (NILP (Vinhibit_point_motion_hooks) - && ((! NULL_INTERVAL_P (to) && ! NULL_INTERVAL_P (toprev)) + && ((to && toprev) || have_overlays) /* Intangibility never stops us from positioning at the beginning or end of the buffer, so don't bother checking in that case. */ @@ -1994,7 +2000,7 @@ set_point_both (ptrdiff_t charpos, ptrdiff_t bytepos) /* Set TO to the interval containing the char after CHARPOS, and TOPREV to the interval containing the char before CHARPOS. Either one may be null. They may be equal. */ - to = find_interval (BUF_INTERVALS (current_buffer), charpos); + to = find_interval (buffer_get_intervals (current_buffer), charpos); if (charpos == BEGV) toprev = 0; else if (to && to->position == charpos) @@ -2127,15 +2133,15 @@ get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val, INTERVAL i, prev, next; if (NILP (object)) - i = find_interval (BUF_INTERVALS (current_buffer), pos); + i = find_interval (buffer_get_intervals (current_buffer), pos); else if (BUFFERP (object)) - i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos); + i = find_interval (buffer_get_intervals (XBUFFER (object)), pos); else if (STRINGP (object)) - i = find_interval (STRING_INTERVALS (object), pos); + i = find_interval (string_get_intervals (object), pos); else abort (); - if (NULL_INTERVAL_P (i) || (i->position + LENGTH (i) <= pos)) + if (!i || (i->position + LENGTH (i) <= pos)) return 0; *val = textget (i->plist, prop); if (NILP (*val)) @@ -2143,14 +2149,13 @@ get_property_and_range (ptrdiff_t pos, Lisp_Object prop, Lisp_Object *val, next = i; /* remember it in advance */ prev = previous_interval (i); - while (! NULL_INTERVAL_P (prev) + while (prev && EQ (*val, textget (prev->plist, prop))) i = prev, prev = previous_interval (prev); *start = i->position; next = next_interval (i); - while (! NULL_INTERVAL_P (next) - && EQ (*val, textget (next->plist, prop))) + while (next && EQ (*val, textget (next->plist, prop))) i = next, next = next_interval (next); *end = i->position + LENGTH (i); @@ -2221,22 +2226,22 @@ copy_intervals (INTERVAL tree, ptrdiff_t start, ptrdiff_t length) register INTERVAL i, new, t; register ptrdiff_t got, prevlen; - if (NULL_INTERVAL_P (tree) || length <= 0) - return NULL_INTERVAL; + if (!tree || length <= 0) + return NULL; i = find_interval (tree, start); - eassert (!NULL_INTERVAL_P (i) && LENGTH (i) > 0); + eassert (i && LENGTH (i) > 0); /* If there is only one interval and it's the default, return nil. */ if ((start - i->position + 1 + length) < LENGTH (i) && DEFAULT_INTERVAL_P (i)) - return NULL_INTERVAL; + return NULL; new = make_interval (); new->position = 0; got = (LENGTH (i) - (start - i->position)); new->total_length = length; - CHECK_TOTAL_LENGTH (new); + eassert (0 <= TOTAL_LENGTH (new)); copy_properties (i, new); t = new; @@ -2259,13 +2264,13 @@ void copy_intervals_to_string (Lisp_Object string, struct buffer *buffer, ptrdiff_t position, ptrdiff_t length) { - INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer), + INTERVAL interval_copy = copy_intervals (buffer_get_intervals (buffer), position, length); - if (NULL_INTERVAL_P (interval_copy)) + if (!interval_copy) return; - SET_INTERVAL_OBJECT (interval_copy, string); - STRING_SET_INTERVALS (string, interval_copy); + interval_set_object (interval_copy, string); + string_set_intervals (string, interval_copy); } /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise. @@ -2278,8 +2283,8 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) ptrdiff_t pos = 0; ptrdiff_t end = SCHARS (s1); - i1 = find_interval (STRING_INTERVALS (s1), 0); - i2 = find_interval (STRING_INTERVALS (s2), 0); + i1 = find_interval (string_get_intervals (s1), 0); + i2 = find_interval (string_get_intervals (s2), 0); while (pos < end) { @@ -2319,7 +2324,7 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag, i->total_length = end - start; else i->total_length = end_byte - start_byte; - CHECK_TOTAL_LENGTH (i); + eassert (0 <= TOTAL_LENGTH (i)); if (TOTAL_LENGTH (i) == 0) { @@ -2404,13 +2409,13 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag, { if ((i)->left) { - (i)->plist = (i)->left->plist; + interval_set_plist (i, i->left->plist); (i)->left->total_length = 0; delete_interval ((i)->left); } else { - (i)->plist = (i)->right->plist; + interval_set_plist (i, i->right->plist); (i)->right->total_length = 0; delete_interval ((i)->right); } @@ -2424,7 +2429,8 @@ set_intervals_multibyte_1 (INTERVAL i, int multi_flag, void set_intervals_multibyte (int multi_flag) { - if (BUF_INTERVALS (current_buffer)) - set_intervals_multibyte_1 (BUF_INTERVALS (current_buffer), multi_flag, - BEG, BEG_BYTE, Z, Z_BYTE); + INTERVAL i = buffer_get_intervals (current_buffer); + + if (i) + set_intervals_multibyte_1 (i, multi_flag, BEG, BEG_BYTE, Z, Z_BYTE); } diff --git a/src/intervals.h b/src/intervals.h index d78289d897e..a5166c6376f 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -18,8 +18,10 @@ along with GNU Emacs. If not, see . */ #include "dispextern.h" -#define NULL_INTERVAL ((INTERVAL)0) -#define INTERVAL_DEFAULT NULL_INTERVAL +INLINE_HEADER_BEGIN +#ifndef INTERVALS_INLINE +# define INTERVALS_INLINE INLINE +#endif /* Basic data type for use of intervals. */ @@ -61,34 +63,25 @@ struct interval /* These are macros for dealing with the interval tree. */ -/* Size of the structure used to represent an interval. */ -#define INTERVAL_SIZE (sizeof (struct interval)) - -/* Size of a pointer to an interval structure. */ -#define INTERVAL_PTR_SIZE (sizeof (struct interval *)) - -#define NULL_INTERVAL_P(i) ((i) == NULL_INTERVAL) - /* True if this interval has no right child. */ -#define NULL_RIGHT_CHILD(i) ((i)->right == NULL_INTERVAL) +#define NULL_RIGHT_CHILD(i) ((i)->right == NULL) /* True if this interval has no left child. */ -#define NULL_LEFT_CHILD(i) ((i)->left == NULL_INTERVAL) +#define NULL_LEFT_CHILD(i) ((i)->left == NULL) /* True if this interval has no parent. */ #define NULL_PARENT(i) ((i)->up_obj || (i)->up.interval == 0) /* True if this interval is the left child of some other interval. */ -#define AM_LEFT_CHILD(i) (! NULL_PARENT (i) \ - && INTERVAL_PARENT (i)->left == (i)) +#define AM_LEFT_CHILD(i) \ + (! NULL_PARENT (i) && INTERVAL_PARENT (i)->left == (i)) /* True if this interval is the right child of some other interval. */ -#define AM_RIGHT_CHILD(i) (! NULL_PARENT (i) \ - && INTERVAL_PARENT (i)->right == (i)) +#define AM_RIGHT_CHILD(i) \ + (! NULL_PARENT (i) && INTERVAL_PARENT (i)->right == (i)) /* True if this interval has no children. */ -#define LEAF_INTERVAL_P(i) ((i)->left == NULL_INTERVAL \ - && (i)->right == NULL_INTERVAL) +#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL) /* True if this interval has no parent and is therefore the root. */ #define ROOT_INTERVAL_P(i) (NULL_PARENT (i)) @@ -97,17 +90,16 @@ struct interval #define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i))) /* True if this interval has both left and right children. */ -#define BOTH_KIDS_P(i) ((i)->left != NULL_INTERVAL \ - && (i)->right != NULL_INTERVAL) +#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL) /* The total size of all text represented by this interval and all its children in the tree. This is zero if the interval is null. */ -#define TOTAL_LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (i)->total_length) +#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length) /* The size of text represented by this interval alone. */ -#define LENGTH(i) ((i) == NULL_INTERVAL ? 0 : (TOTAL_LENGTH ((i)) \ - - TOTAL_LENGTH ((i)->right) \ - - TOTAL_LENGTH ((i)->left))) +#define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \ + - TOTAL_LENGTH ((i)->right) \ + - TOTAL_LENGTH ((i)->left))) /* The position of the character just past the end of I. Note that the position cache i->position must be valid for this to work. */ @@ -119,125 +111,143 @@ struct interval /* The total size of the right subtree of this interval. */ #define RIGHT_TOTAL_LENGTH(i) ((i)->right ? (i)->right->total_length : 0) - /* These macros are for dealing with the interval properties. */ /* True if this is a default interval, which is the same as being null or having no properties. */ -#define DEFAULT_INTERVAL_P(i) (NULL_INTERVAL_P (i) || EQ ((i)->plist, Qnil)) +#define DEFAULT_INTERVAL_P(i) (!i || EQ ((i)->plist, Qnil)) /* Test what type of parent we have. Three possibilities: another - interval, a buffer or string object, or NULL_INTERVAL. */ + interval, a buffer or string object, or NULL. */ #define INTERVAL_HAS_PARENT(i) ((i)->up_obj == 0 && (i)->up.interval != 0) #define INTERVAL_HAS_OBJECT(i) ((i)->up_obj) -/* Set/get parent of an interval. +/* Use these macros to get parent of an interval. The choice of macros is dependent on the type needed. Don't add casts to get around this, it will break some development work in progress. */ -#define SET_INTERVAL_PARENT(i,p) \ - ((i)->up_obj = 0, (i)->up.interval = (p)) -#define SET_INTERVAL_OBJECT(i,o) \ - (eassert (BUFFERP (o) || STRINGP (o)), (i)->up_obj = 1, (i)->up.obj = (o)) -#define INTERVAL_PARENT(i) \ - (eassert ((i) != 0 && (i)->up_obj == 0),(i)->up.interval) -#define GET_INTERVAL_OBJECT(d,s) (eassert((s)->up_obj == 1), (d) = (s)->up.obj) -/* Make the parent of D be whatever the parent of S is, regardless of - type. This is used when balancing an interval tree. */ -#define COPY_INTERVAL_PARENT(d,s) \ - ((d)->up = (s)->up, (d)->up_obj = (s)->up_obj) +#define INTERVAL_PARENT(i) \ + (eassert ((i) != 0 && (i)->up_obj == 0), (i)->up.interval) + +#define GET_INTERVAL_OBJECT(d,s) (eassert ((s)->up_obj == 1), (d) = (s)->up.obj) + +/* Use these functions to set Lisp_Object + or pointer slots of struct interval. */ + +INTERVALS_INLINE void +interval_set_parent (INTERVAL i, INTERVAL parent) +{ + i->up_obj = 0; + i->up.interval = parent; +} + +INTERVALS_INLINE void +interval_set_object (INTERVAL i, Lisp_Object obj) +{ + eassert (BUFFERP (obj) || STRINGP (obj)); + i->up_obj = 1; + i->up.obj = obj; +} + +INTERVALS_INLINE void +interval_set_left (INTERVAL i, INTERVAL left) +{ + i->left = left; +} + +INTERVALS_INLINE void +interval_set_right (INTERVAL i, INTERVAL right) +{ + i->right = right; +} + +INTERVALS_INLINE Lisp_Object +interval_set_plist (INTERVAL i, Lisp_Object plist) +{ + i->plist = plist; + return plist; +} + +/* Make the parent of D be whatever the parent of S is, regardless + of the type. This is used when balancing an interval tree. */ + +INTERVALS_INLINE void +interval_copy_parent (INTERVAL d, INTERVAL s) +{ + d->up = s->up; + d->up_obj = s->up_obj; +} /* Get the parent interval, if any, otherwise a null pointer. Useful for walking up to the root in a "for" loop; use this to get the - "next" value, and test the result to see if it's NULL_INTERVAL. */ + "next" value, and test the result to see if it's NULL. */ #define INTERVAL_PARENT_OR_NULL(i) \ (INTERVAL_HAS_PARENT (i) ? INTERVAL_PARENT (i) : 0) -/* Abort if interval I's size is negative. */ -#define CHECK_TOTAL_LENGTH(i) \ - do \ - { \ - if ((i)->total_length < 0) \ - abort (); \ - } \ - while (0) - /* Reset this interval to its vanilla, or no-property state. */ -#define RESET_INTERVAL(i) \ -{ \ - (i)->total_length = (i)->position = 0; \ - (i)->left = (i)->right = NULL_INTERVAL; \ - SET_INTERVAL_PARENT (i, NULL_INTERVAL); \ - (i)->write_protect = 0; \ - (i)->visible = 0; \ - (i)->front_sticky = (i)->rear_sticky = 0; \ - (i)->plist = Qnil; \ +#define RESET_INTERVAL(i) \ +{ \ + (i)->total_length = (i)->position = 0; \ + (i)->left = (i)->right = NULL; \ + interval_set_parent (i, NULL); \ + (i)->write_protect = 0; \ + (i)->visible = 0; \ + (i)->front_sticky = (i)->rear_sticky = 0; \ + interval_set_plist (i, Qnil); \ } /* Copy the cached property values of interval FROM to interval TO. */ -#define COPY_INTERVAL_CACHE(from,to) \ -{ \ - (to)->write_protect = (from)->write_protect; \ - (to)->visible = (from)->visible; \ - (to)->front_sticky = (from)->front_sticky; \ - (to)->rear_sticky = (from)->rear_sticky; \ +#define COPY_INTERVAL_CACHE(from,to) \ +{ \ + (to)->write_protect = (from)->write_protect; \ + (to)->visible = (from)->visible; \ + (to)->front_sticky = (from)->front_sticky; \ + (to)->rear_sticky = (from)->rear_sticky; \ } /* Copy only the set bits of FROM's cache. */ -#define MERGE_INTERVAL_CACHE(from,to) \ -{ \ +#define MERGE_INTERVAL_CACHE(from,to) \ +{ \ if ((from)->write_protect) (to)->write_protect = 1; \ - if ((from)->visible) (to)->visible = 1; \ + if ((from)->visible) (to)->visible = 1; \ if ((from)->front_sticky) (to)->front_sticky = 1; \ if ((from)->rear_sticky) (to)->rear_sticky = 1; \ } -/* Macro determining whether the properties of an interval being - inserted should be merged with the properties of the text where - they are being inserted. */ -#define MERGE_INSERTIONS(i) 1 - -/* Macro determining if an invisible interval should be displayed - as a special glyph, or not at all. */ -#define DISPLAY_INVISIBLE_GLYPH(i) 0 - /* Is this interval visible? Replace later with cache access. */ #define INTERVAL_VISIBLE_P(i) \ - (! NULL_INTERVAL_P (i) && NILP (textget ((i)->plist, Qinvisible))) + (i && NILP (textget ((i)->plist, Qinvisible))) /* Is this interval writable? Replace later with cache access. */ #define INTERVAL_WRITABLE_P(i) \ - (! NULL_INTERVAL_P (i) \ - && (NILP (textget ((i)->plist, Qread_only)) \ - || ((CONSP (Vinhibit_read_only) \ - ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \ - Vinhibit_read_only)) \ - : !NILP (Vinhibit_read_only))))) \ + (i && (NILP (textget ((i)->plist, Qread_only)) \ + || ((CONSP (Vinhibit_read_only) \ + ? !NILP (Fmemq (textget ((i)->plist, Qread_only), \ + Vinhibit_read_only)) \ + : !NILP (Vinhibit_read_only))))) \ /* Macros to tell whether insertions before or after this interval - should stick to it. */ -/* Replace later with cache access */ -/*#define FRONT_STICKY_P(i) ((i)->front_sticky != 0) - #define END_STICKY_P(i) ((i)->rear_sticky != 0)*/ -/* As we now have Vtext_property_default_nonsticky, these macros are - unreliable now. Currently, they are never used. */ -#define FRONT_STICKY_P(i) \ - (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qfront_sticky))) -#define END_NONSTICKY_P(i) \ - (! NULL_INTERVAL_P (i) && ! NILP (textget ((i)->plist, Qrear_nonsticky))) -#define FRONT_NONSTICKY_P(i) \ - (! NULL_INTERVAL_P (i) && ! EQ (Qt, textget ((i)->plist, Qfront_sticky))) + should stick to it. Now we have Vtext_property_default_nonsticky, + so these macros are unreliable now and never used. */ +#if 0 +#define FRONT_STICKY_P(i) \ + (i && ! NILP (textget ((i)->plist, Qfront_sticky))) +#define END_NONSTICKY_P(i) \ + (i && ! NILP (textget ((i)->plist, Qrear_nonsticky))) +#define FRONT_NONSTICKY_P(i) \ + (i && ! EQ (Qt, textget ((i)->plist, Qfront_sticky))) +#endif /* If PROP is the `invisible' property of a character, this is 1 if the character should be treated as invisible, and 2 if it is invisible but with an ellipsis. */ -#define TEXT_PROP_MEANS_INVISIBLE(prop) \ +#define TEXT_PROP_MEANS_INVISIBLE(prop) \ (EQ (BVAR (current_buffer, invisibility_spec), Qt) \ - ? !NILP (prop) \ + ? !NILP (prop) \ : invisible_p (prop, BVAR (current_buffer, invisibility_spec))) /* Declared in alloc.c. */ @@ -326,3 +336,5 @@ extern Lisp_Object get_pos_property (Lisp_Object pos, Lisp_Object prop, extern void syms_of_textprop (void); #include "composite.h" + +INLINE_HEADER_END diff --git a/src/keyboard.c b/src/keyboard.c index 1d5e5566236..0b3c48ab713 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -395,7 +395,7 @@ int interrupt_input; /* Nonzero while interrupts are temporarily deferred during redisplay. */ int interrupts_deferred; -/* Allow m- file to inhibit use of FIONREAD. */ +/* Allow configure to inhibit use of FIONREAD. */ #ifdef BROKEN_FIONREAD #undef FIONREAD #endif @@ -554,8 +554,8 @@ echo_char (Lisp_Object c) else if (STRINGP (echo_string)) echo_string = concat2 (echo_string, build_string (" ")); - KVAR (current_kboard, echo_string) - = concat2 (echo_string, make_string (buffer, ptr - buffer)); + KSET (current_kboard, echo_string, + concat2 (echo_string, make_string (buffer, ptr - buffer))); echo_now (); } @@ -600,8 +600,8 @@ echo_dash (void) /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ - KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string), - build_string ("-")); + KSET (current_kboard, echo_string, + concat2 (KVAR (current_kboard, echo_string), build_string ("-"))); echo_now (); } @@ -663,7 +663,7 @@ cancel_echoing (void) { current_kboard->immediate_echo = 0; current_kboard->echo_after_prompt = -1; - KVAR (current_kboard, echo_string) = Qnil; + KSET (current_kboard, echo_string, Qnil); ok_to_echo_at_next_pause = NULL; echo_kboard = NULL; echo_message_buffer = Qnil; @@ -687,9 +687,9 @@ static void echo_truncate (ptrdiff_t nchars) { if (STRINGP (KVAR (current_kboard, echo_string))) - KVAR (current_kboard, echo_string) - = Fsubstring (KVAR (current_kboard, echo_string), - make_number (0), make_number (nchars)); + KSET (current_kboard, echo_string, + Fsubstring (KVAR (current_kboard, echo_string), + make_number (0), make_number (nchars))); truncate_echo_area (nchars); } @@ -803,7 +803,7 @@ This function is called by the editor initialization to begin editing. */) update_mode_lines = 1; if (command_loop_level - && current_buffer != XBUFFER (WVAR (XWINDOW (selected_window), buffer))) + && current_buffer != XBUFFER (XWINDOW (selected_window)->buffer)) buffer = Fcurrent_buffer (); else buffer = Qnil; @@ -1019,8 +1019,8 @@ cmd_error (Lisp_Object data) Vstandard_input = Qt; Vexecuting_kbd_macro = Qnil; executing_kbd_macro = Qnil; - KVAR (current_kboard, Vprefix_arg) = Qnil; - KVAR (current_kboard, Vlast_prefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); + KSET (current_kboard, Vlast_prefix_arg, Qnil); cancel_echoing (); /* Avoid unquittable loop if data contains a circular list. */ @@ -1341,8 +1341,8 @@ command_loop_1 (void) #endif int already_adjusted = 0; - KVAR (current_kboard, Vprefix_arg) = Qnil; - KVAR (current_kboard, Vlast_prefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); + KSET (current_kboard, Vlast_prefix_arg, Qnil); Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); @@ -1374,10 +1374,10 @@ command_loop_1 (void) } /* Do this after running Vpost_command_hook, for consistency. */ - KVAR (current_kboard, Vlast_command) = Vthis_command; - KVAR (current_kboard, Vreal_last_command) = Vreal_this_command; + KSET (current_kboard, Vlast_command, Vthis_command); + KSET (current_kboard, Vreal_last_command, Vreal_this_command); if (!CONSP (last_command_event)) - KVAR (current_kboard, Vlast_repeatable_command) = Vreal_this_command; + KSET (current_kboard, Vlast_repeatable_command, Vreal_this_command); while (1) { @@ -1385,8 +1385,8 @@ command_loop_1 (void) Fkill_emacs (Qnil); /* Make sure the current window's buffer is selected. */ - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) != current_buffer) - set_buffer_internal (XBUFFER (WVAR (XWINDOW (selected_window), buffer))); + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) + set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); /* Display any malloc warning that just came out. Use while because displaying one warning can cause another. */ @@ -1396,6 +1396,15 @@ command_loop_1 (void) Vdeactivate_mark = Qnil; +#if defined (HAVE_MOUSE) || defined (HAVE_GPM) + + /* Don't ignore mouse movements for more than a single command + loop. (This flag is set in xdisp.c whenever the tool bar is + resized, because the resize moves text up or down, and would + generate false mouse drag events if we don't ignore them.) */ + ignore_mouse_drag_p = 0; +#endif + /* If minibuffer on and echo area in use, wait a short time and redraw minibuffer. */ @@ -1455,8 +1464,8 @@ command_loop_1 (void) /* A filter may have run while we were reading the input. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) != current_buffer) - set_buffer_internal (XBUFFER (WVAR (XWINDOW (selected_window), buffer))); + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) + set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); ++num_input_keys; @@ -1487,7 +1496,7 @@ command_loop_1 (void) { struct buffer *b; XWINDOW (selected_window)->force_start = 0; - b = XBUFFER (WVAR (XWINDOW (selected_window), buffer)); + b = XBUFFER (XWINDOW (selected_window)->buffer); BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0; } @@ -1540,7 +1549,7 @@ command_loop_1 (void) keys = Fkey_description (keys, Qnil); bitch_at_user (); message_with_string ("%s is undefined", keys, 0); - KVAR (current_kboard, defining_kbd_macro) = Qnil; + KSET (current_kboard, defining_kbd_macro, Qnil); update_mode_lines = 1; /* If this is a down-mouse event, don't reset prefix-arg; pass it to the command run by the up event. */ @@ -1550,10 +1559,10 @@ command_loop_1 (void) = parse_modifiers (EVENT_HEAD (last_command_event)); int modifiers = XINT (XCAR (XCDR (breakdown))); if (!(modifiers & down_modifier)) - KVAR (current_kboard, Vprefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); } else - KVAR (current_kboard, Vprefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); } else { @@ -1590,7 +1599,7 @@ command_loop_1 (void) unbind_to (scount, Qnil); #endif } - KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg; + KSET (current_kboard, Vlast_prefix_arg, Vcurrent_prefix_arg); safe_run_hooks (Qpost_command_hook); @@ -1621,11 +1630,10 @@ command_loop_1 (void) if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event)) { - KVAR (current_kboard, Vlast_command) = Vthis_command; - KVAR (current_kboard, Vreal_last_command) = Vreal_this_command; + KSET (current_kboard, Vlast_command, Vthis_command); + KSET (current_kboard, Vreal_last_command, Vreal_this_command); if (!CONSP (last_command_event)) - KVAR (current_kboard, Vlast_repeatable_command) - = Vreal_this_command; + KSET (current_kboard, Vlast_repeatable_command, Vreal_this_command); cancel_echoing (); this_command_key_count = 0; this_command_key_count_reset = 0; @@ -2568,7 +2576,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, abort (); } if (!CONSP (last)) - KVAR (kb, kbd_queue) = Fcons (c, Qnil); + KSET (kb, kbd_queue, Fcons (c, Qnil)); else XSETCDR (last, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -2740,8 +2748,8 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, if (!CONSP (KVAR (current_kboard, kbd_queue))) abort (); c = XCAR (KVAR (current_kboard, kbd_queue)); - KVAR (current_kboard, kbd_queue) - = XCDR (KVAR (current_kboard, kbd_queue)); + KSET (current_kboard, kbd_queue, + XCDR (KVAR (current_kboard, kbd_queue))); if (NILP (KVAR (current_kboard, kbd_queue))) current_kboard->kbd_queue_has_data = 0; input_pending = readable_events (0); @@ -2808,7 +2816,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, abort (); } if (!CONSP (last)) - KVAR (kb, kbd_queue) = Fcons (c, Qnil); + KSET (kb, kbd_queue, Fcons (c, Qnil)); else XSETCDR (last, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -3066,7 +3074,7 @@ read_char (int commandflag, ptrdiff_t nmaps, Lisp_Object *maps, cancel_echoing (); ok_to_echo_at_next_pause = saved_ok_to_echo; - KVAR (current_kboard, echo_string) = saved_echo_string; + KSET (current_kboard, echo_string, saved_echo_string); current_kboard->echo_after_prompt = saved_echo_after_prompt; if (saved_immediate_echo) echo_now (); @@ -3537,9 +3545,9 @@ kbd_buffer_store_event_hold (register struct input_event *event, if (single_kboard && kb != current_kboard) { - KVAR (kb, kbd_queue) - = Fcons (make_lispy_switch_frame (event->frame_or_window), - Fcons (make_number (c), Qnil)); + KSET (kb, kbd_queue, + Fcons (make_lispy_switch_frame (event->frame_or_window), + Fcons (make_number (c), Qnil))); kb->kbd_queue_has_data = 1; for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) { @@ -4469,6 +4477,7 @@ timer_check_2 (void) } nexttime = make_emacs_time (0, 0); + break; } else /* When we encounter a timer that is still waiting, @@ -5184,8 +5193,8 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, if (STRINGP (string)) string_info = Fcons (string, make_number (charpos)); textpos = (w == XWINDOW (selected_window) - && current_buffer == XBUFFER (WVAR (w, buffer))) - ? PT : XMARKER (WVAR (w, pointm))->charpos; + && current_buffer == XBUFFER (w->buffer)) + ? PT : XMARKER (w->pointm)->charpos; xret = wx; yret = wy; @@ -5417,7 +5426,7 @@ make_lispy_event (struct input_event *event) /* We need to use an alist rather than a vector as the cache since we can't make a vector long enough. */ if (NILP (KVAR (current_kboard, system_key_syms))) - KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil); + KSET (current_kboard, system_key_syms, Fcons (Qnil, Qnil)); return modify_event_symbol (event->code, event->modifiers, Qfunction_key, @@ -5561,7 +5570,7 @@ make_lispy_event (struct input_event *event) mouse_syms = larger_vector (mouse_syms, incr, -1); } - start_pos_ptr = &AREF (button_down_location, button); + start_pos_ptr = aref_addr (button_down_location, button); start_pos = *start_pos_ptr; *start_pos_ptr = Qnil; @@ -5573,7 +5582,7 @@ make_lispy_event (struct input_event *event) int fuzz; if (WINDOWP (event->frame_or_window)) - f = XFRAME (WVAR (XWINDOW (event->frame_or_window), frame)); + f = XFRAME (XWINDOW (event->frame_or_window)->frame); else if (FRAMEP (event->frame_or_window)) f = XFRAME (event->frame_or_window); else @@ -5741,7 +5750,7 @@ make_lispy_event (struct input_event *event) int is_double; if (WINDOWP (event->frame_or_window)) - fr = XFRAME (WVAR (XWINDOW (event->frame_or_window), frame)); + fr = XFRAME (XWINDOW (event->frame_or_window)->frame); else if (FRAMEP (event->frame_or_window)) fr = XFRAME (event->frame_or_window); else @@ -5975,7 +5984,7 @@ make_lispy_event (struct input_event *event) mouse_syms = larger_vector (mouse_syms, incr, -1); } - start_pos_ptr = &AREF (button_down_location, button); + start_pos_ptr = aref_addr (button_down_location, button); start_pos = *start_pos_ptr; position = make_lispy_position (f, event->x, event->y, @@ -6496,7 +6505,7 @@ modify_event_symbol (ptrdiff_t symbol_num, int modifiers, Lisp_Object symbol_kin ptrdiff_t len = (SBYTES (name_alist_or_stem) + sizeof "-" + INT_STRLEN_BOUND (EMACS_INT)); USE_SAFE_ALLOCA; - SAFE_ALLOCA (buf, char *, len); + buf = SAFE_ALLOCA (len); esprintf (buf, "%s-%"pI"d", SDATA (name_alist_or_stem), XINT (symbol_int) + 1); value = intern (buf); @@ -7481,7 +7490,7 @@ menu_bar_items (Lisp_Object old) if (!NILP (Voverriding_local_map_menu_flag)) { /* Yes, use them (if non-nil) as well as the global map. */ - maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); + maps = alloca (3 * sizeof (maps[0])); nmaps = 0; if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); @@ -7541,9 +7550,9 @@ menu_bar_items (Lisp_Object old) tem2 = AREF (menu_bar_items_vector, i + 2); tem3 = AREF (menu_bar_items_vector, i + 3); if (end > i + 4) - memmove (&AREF (menu_bar_items_vector, i), - &AREF (menu_bar_items_vector, i + 4), - (end - i - 4) * sizeof (Lisp_Object)); + memmove (aref_addr (menu_bar_items_vector, i), + aref_addr (menu_bar_items_vector, i + 4), + (end - i - 4) * word_size); ASET (menu_bar_items_vector, end - 4, tem0); ASET (menu_bar_items_vector, end - 3, tem1); ASET (menu_bar_items_vector, end - 2, tem2); @@ -7591,9 +7600,9 @@ menu_bar_item (Lisp_Object key, Lisp_Object item, Lisp_Object dummy1, void *dumm if (EQ (key, AREF (menu_bar_items_vector, i))) { if (menu_bar_items_index > i + 4) - memmove (&AREF (menu_bar_items_vector, i), - &AREF (menu_bar_items_vector, i + 4), - (menu_bar_items_index - i - 4) * sizeof (Lisp_Object)); + memmove (aref_addr (menu_bar_items_vector, i), + aref_addr (menu_bar_items_vector, i + 4), + (menu_bar_items_index - i - 4) * word_size); menu_bar_items_index -= 4; } } @@ -7911,7 +7920,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) (such as lmenu.el set it up), check if the original command matches the cached command. */ && !(SYMBOLP (def) - && EQ (tem, SVAR (XSYMBOL (def), function))))) + && EQ (tem, XSYMBOL (def)->function)))) keys = Qnil; } @@ -8098,7 +8107,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS) memmove (v, v + TOOL_BAR_ITEM_NSLOTS, ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS) - * sizeof (Lisp_Object))); + * word_size)); ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS; break; } @@ -8112,6 +8121,14 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void UNGCPRO; } +/* Access slot with index IDX of vector tool_bar_item_properties. */ +#define PROP(IDX) AREF (tool_bar_item_properties, (IDX)) +static inline void +set_prop (ptrdiff_t idx, Lisp_Object val) +{ + ASET (tool_bar_item_properties, idx, val); +} + /* Parse a tool bar item specification ITEM for key KEY and return the result in tool_bar_item_properties. Value is zero if ITEM is @@ -8162,9 +8179,6 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void static int parse_tool_bar_item (Lisp_Object key, Lisp_Object item) { - /* Access slot with index IDX of vector tool_bar_item_properties. */ -#define PROP(IDX) AREF (tool_bar_item_properties, (IDX)) - Lisp_Object filter = Qnil; Lisp_Object caption; int i, have_label = 0; @@ -8188,15 +8202,15 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) if (VECTORP (tool_bar_item_properties)) { for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i) - PROP (i) = Qnil; + set_prop (i, Qnil); } else tool_bar_item_properties = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil); /* Set defaults. */ - PROP (TOOL_BAR_ITEM_KEY) = key; - PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt; + set_prop (TOOL_BAR_ITEM_KEY, key); + set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt); /* Get the caption of the item. If the caption is not a string, evaluate it to get a string. If we don't get a string, skip this @@ -8208,7 +8222,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) if (!STRINGP (caption)) return 0; } - PROP (TOOL_BAR_ITEM_CAPTION) = caption; + set_prop (TOOL_BAR_ITEM_CAPTION, caption); /* If the rest following the caption is not a list, the menu item is either a separator, or invalid. */ @@ -8217,7 +8231,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) { if (menu_separator_name_p (SSDATA (caption))) { - PROP (TOOL_BAR_ITEM_TYPE) = Qt; + set_prop (TOOL_BAR_ITEM_TYPE, Qt); #if !defined (USE_GTK) && !defined (HAVE_NS) /* If we use build_desired_tool_bar_string to render the tool bar, the separator is rendered as an image. */ @@ -8233,7 +8247,7 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) } /* Store the binding. */ - PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item); + set_prop (TOOL_BAR_ITEM_BINDING, XCAR (item)); item = XCDR (item); /* Ignore cached key binding, if any. */ @@ -8252,9 +8266,9 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) { /* `:enable FORM'. */ if (!NILP (Venable_disabled_menus_and_buttons)) - PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt; + set_prop (TOOL_BAR_ITEM_ENABLED_P, Qt); else - PROP (TOOL_BAR_ITEM_ENABLED_P) = value; + set_prop (TOOL_BAR_ITEM_ENABLED_P, value); } else if (EQ (ikey, QCvisible)) { @@ -8265,17 +8279,16 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) } else if (EQ (ikey, QChelp)) /* `:help HELP-STRING'. */ - PROP (TOOL_BAR_ITEM_HELP) = value; + set_prop (TOOL_BAR_ITEM_HELP, value); else if (EQ (ikey, QCvert_only)) /* `:vert-only t/nil'. */ - PROP (TOOL_BAR_ITEM_VERT_ONLY) = value; + set_prop (TOOL_BAR_ITEM_VERT_ONLY, value); else if (EQ (ikey, QClabel)) { const char *bad_label = "!!?GARBLED ITEM?!!"; /* `:label LABEL-STRING'. */ - PROP (TOOL_BAR_ITEM_LABEL) = STRINGP (value) - ? value - : build_string (bad_label); + set_prop (TOOL_BAR_ITEM_LABEL, + STRINGP (value) ? value : build_string (bad_label)); have_label = 1; } else if (EQ (ikey, QCfilter)) @@ -8290,8 +8303,8 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) selected = XCDR (value); if (EQ (type, QCtoggle) || EQ (type, QCradio)) { - PROP (TOOL_BAR_ITEM_SELECTED_P) = selected; - PROP (TOOL_BAR_ITEM_TYPE) = type; + set_prop (TOOL_BAR_ITEM_SELECTED_P, selected); + set_prop (TOOL_BAR_ITEM_TYPE, type); } } else if (EQ (ikey, QCimage) @@ -8299,10 +8312,10 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) || (VECTORP (value) && ASIZE (value) == 4))) /* Value is either a single image specification or a vector of 4 such specifications for the different button states. */ - PROP (TOOL_BAR_ITEM_IMAGES) = value; + set_prop (TOOL_BAR_ITEM_IMAGES, value); else if (EQ (ikey, QCrtl)) /* ':rtl STRING' */ - PROP (TOOL_BAR_ITEM_RTL_IMAGE) = value; + set_prop (TOOL_BAR_ITEM_RTL_IMAGE, value); } @@ -8344,18 +8357,19 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) new_lbl = Fupcase_initials (build_string (label)); if (SCHARS (new_lbl) <= tool_bar_max_label_size) - PROP (TOOL_BAR_ITEM_LABEL) = new_lbl; + set_prop (TOOL_BAR_ITEM_LABEL, new_lbl); else - PROP (TOOL_BAR_ITEM_LABEL) = empty_unibyte_string; + set_prop (TOOL_BAR_ITEM_LABEL, empty_unibyte_string); xfree (buf); } /* If got a filter apply it on binding. */ if (!NILP (filter)) - PROP (TOOL_BAR_ITEM_BINDING) - = menu_item_eval_property (list2 (filter, - list2 (Qquote, - PROP (TOOL_BAR_ITEM_BINDING)))); + set_prop (TOOL_BAR_ITEM_BINDING, + (menu_item_eval_property + (list2 (filter, + list2 (Qquote, + PROP (TOOL_BAR_ITEM_BINDING)))))); /* See if the binding is a keymap. Give up if it is. */ if (CONSP (get_keymap (PROP (TOOL_BAR_ITEM_BINDING), 0, 1))) @@ -8363,13 +8377,13 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) /* Enable or disable selection of item. */ if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt)) - PROP (TOOL_BAR_ITEM_ENABLED_P) - = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)); + set_prop (TOOL_BAR_ITEM_ENABLED_P, + menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P))); /* Handle radio buttons or toggle boxes. */ if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P))) - PROP (TOOL_BAR_ITEM_SELECTED_P) - = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)); + set_prop (TOOL_BAR_ITEM_SELECTED_P, + menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P))); return 1; @@ -8443,7 +8457,9 @@ static Lisp_Object read_char_x_menu_prompt (ptrdiff_t nmaps, Lisp_Object *maps, Lisp_Object prev_event, int *used_mouse_menu) { +#ifdef HAVE_MENUS ptrdiff_t mapno; +#endif if (used_mouse_menu) *used_mouse_menu = 0; @@ -8739,11 +8755,11 @@ read_char_minibuf_menu_prompt (int commandflag, is not used on replay. */ orig_defn_macro = KVAR (current_kboard, defining_kbd_macro); - KVAR (current_kboard, defining_kbd_macro) = Qnil; + KSET (current_kboard, defining_kbd_macro, Qnil); do obj = read_char (commandflag, 0, 0, Qt, 0, NULL); while (BUFFERP (obj)); - KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro; + KSET (current_kboard, defining_kbd_macro, orig_defn_macro); if (!INTEGERP (obj)) return obj; @@ -8840,14 +8856,14 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, /* Handle a symbol whose function definition is a keymap or an array. */ if (SYMBOLP (next) && !NILP (Ffboundp (next)) - && (ARRAYP (SVAR (XSYMBOL (next), function)) - || KEYMAPP (SVAR (XSYMBOL (next), function)))) - next = Fautoload_do_load (SVAR (XSYMBOL (next), function), next, Qnil); + && (ARRAYP (XSYMBOL (next)->function) + || KEYMAPP (XSYMBOL (next)->function))) + next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil); /* If the keymap gives a function, not an array, then call the function with one arg and use its value instead. */ - if (SYMBOLP (next) && !NILP (Ffboundp (next)) && do_funcall) + if (do_funcall && FUNCTIONP (next)) { Lisp_Object tem; tem = next; @@ -9099,7 +9115,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, /* Install the string STR as the beginning of the string of echoing, so that it serves as a prompt for the next character. */ - KVAR (current_kboard, echo_string) = prompt; + KSET (current_kboard, echo_string, prompt); current_kboard->echo_after_prompt = SCHARS (prompt); echo_now (); } @@ -9345,15 +9361,15 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, if (!NILP (delayed_switch_frame)) { - KVAR (interrupted_kboard, kbd_queue) - = Fcons (delayed_switch_frame, - KVAR (interrupted_kboard, kbd_queue)); + KSET (interrupted_kboard, kbd_queue, + Fcons (delayed_switch_frame, + KVAR (interrupted_kboard, kbd_queue))); delayed_switch_frame = Qnil; } while (t > 0) - KVAR (interrupted_kboard, kbd_queue) - = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)); + KSET (interrupted_kboard, kbd_queue, + Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue))); /* If the side queue is non-empty, ensure it begins with a switch-frame, so we'll replay it in the right context. */ @@ -9365,9 +9381,9 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, { Lisp_Object frame; XSETFRAME (frame, interrupted_frame); - KVAR (interrupted_kboard, kbd_queue) - = Fcons (make_lispy_switch_frame (frame), - KVAR (interrupted_kboard, kbd_queue)); + KSET (interrupted_kboard, kbd_queue, + Fcons (make_lispy_switch_frame (frame), + KVAR (interrupted_kboard, kbd_queue))); } mock_input = 0; orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); @@ -9412,8 +9428,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, { if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) != current_buffer) - Fset_buffer (WVAR (XWINDOW (selected_window), buffer)); + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) + Fset_buffer (XWINDOW (selected_window)->buffer); } orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); @@ -9505,8 +9521,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, not the current buffer. If we're at the beginning of a key sequence, switch buffers. */ if (WINDOWP (window) - && BUFFERP (WVAR (XWINDOW (window), buffer)) - && XBUFFER (WVAR (XWINDOW (window), buffer)) != current_buffer) + && BUFFERP (XWINDOW (window)->buffer) + && XBUFFER (XWINDOW (window)->buffer) != current_buffer) { ASET (raw_keybuf, raw_keybuf_count, key); raw_keybuf_count++; @@ -9527,7 +9543,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); - set_buffer_internal (XBUFFER (WVAR (XWINDOW (window), buffer))); + set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); orig_keymap = get_local_map (PT, current_buffer, @@ -10261,7 +10277,7 @@ a special event, so ignore the prefix argument and don't clear it. */) { prefixarg = KVAR (current_kboard, Vprefix_arg); Vcurrent_prefix_arg = prefixarg; - KVAR (current_kboard, Vprefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); } else prefixarg = Qnil; @@ -10436,9 +10452,9 @@ DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, { val = Fvector (NUM_RECENT_KEYS, keys); memcpy (XVECTOR (val)->contents, keys + recent_keys_index, - (NUM_RECENT_KEYS - recent_keys_index) * sizeof (Lisp_Object)); + (NUM_RECENT_KEYS - recent_keys_index) * word_size); memcpy (XVECTOR (val)->contents + NUM_RECENT_KEYS - recent_keys_index, - keys, recent_keys_index * sizeof (Lisp_Object)); + keys, recent_keys_index * word_size); return val; } } @@ -11211,7 +11227,7 @@ The `posn-' functions access elements of such lists. */) ? window_box_left_offset (w, TEXT_AREA) : 0))); XSETINT (y, WINDOW_TO_FRAME_PIXEL_Y (w, XINT (y))); - frame_or_window = WVAR (w, frame); + frame_or_window = w->frame; } CHECK_LIVE_FRAME (frame_or_window); @@ -11259,30 +11275,30 @@ The `posn-' functions access elements of such lists. */) void init_kboard (KBOARD *kb) { - KVAR (kb, Voverriding_terminal_local_map) = Qnil; - KVAR (kb, Vlast_command) = Qnil; - KVAR (kb, Vreal_last_command) = Qnil; - KVAR (kb, Vkeyboard_translate_table) = Qnil; - KVAR (kb, Vlast_repeatable_command) = Qnil; - KVAR (kb, Vprefix_arg) = Qnil; - KVAR (kb, Vlast_prefix_arg) = Qnil; - KVAR (kb, kbd_queue) = Qnil; + KSET (kb, Voverriding_terminal_local_map, Qnil); + KSET (kb, Vlast_command, Qnil); + KSET (kb, Vreal_last_command, Qnil); + KSET (kb, Vkeyboard_translate_table, Qnil); + KSET (kb, Vlast_repeatable_command, Qnil); + KSET (kb, Vprefix_arg, Qnil); + KSET (kb, Vlast_prefix_arg, Qnil); + KSET (kb, kbd_queue, Qnil); kb->kbd_queue_has_data = 0; kb->immediate_echo = 0; - KVAR (kb, echo_string) = Qnil; + KSET (kb, echo_string, Qnil); kb->echo_after_prompt = -1; kb->kbd_macro_buffer = 0; kb->kbd_macro_bufsize = 0; - KVAR (kb, defining_kbd_macro) = Qnil; - KVAR (kb, Vlast_kbd_macro) = Qnil; + KSET (kb, defining_kbd_macro, Qnil); + KSET (kb, Vlast_kbd_macro, Qnil); kb->reference_count = 0; - KVAR (kb, Vsystem_key_alist) = Qnil; - KVAR (kb, system_key_syms) = Qnil; - KVAR (kb, Vwindow_system) = Qt; /* Unset. */ - KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); - KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil); + KSET (kb, Vsystem_key_alist, Qnil); + KSET (kb, system_key_syms, Qnil); + KSET (kb, Vwindow_system, Qt); /* Unset. */ + KSET (kb, Vinput_decode_map, Fmake_sparse_keymap (Qnil)); + KSET (kb, Vlocal_function_key_map, Fmake_sparse_keymap (Qnil)); Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); - KVAR (kb, Vdefault_minibuffer_frame) = Qnil; + KSET (kb, Vdefault_minibuffer_frame, Qnil); } /* @@ -11358,7 +11374,7 @@ init_keyboard (void) init_kboard (current_kboard); /* A value of nil for Vwindow_system normally means a tty, but we also use it for the initial terminal since there is no window system there. */ - KVAR (current_kboard, Vwindow_system) = Qnil; + KSET (current_kboard, Vwindow_system, Qnil); if (!noninteractive) { diff --git a/src/keyboard.h b/src/keyboard.h index 4006c67d68e..f83643d6f6e 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -22,6 +22,7 @@ along with GNU Emacs. If not, see . */ /* Most code should use this macro to access Lisp fields in struct kboard. */ #define KVAR(kboard, field) ((kboard)->INTERNAL_FIELD (field)) +#define KSET(kboard, field, value) ((kboard)->INTERNAL_FIELD (field) = (value)) /* Each KBOARD represents one logical input stream from which Emacs gets input. If we are using ordinary terminals, it has one KBOARD diff --git a/src/keymap.c b/src/keymap.c index ed8542249e5..c550b37c1d6 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1560,8 +1560,8 @@ like in the respective argument of `key-binding'. */) window = POSN_WINDOW (position); if (WINDOWP (window) - && BUFFERP (WVAR (XWINDOW (window), buffer)) - && XBUFFER (WVAR (XWINDOW (window), buffer)) != current_buffer) + && BUFFERP (XWINDOW (window)->buffer) + && XBUFFER (XWINDOW (window)->buffer) != current_buffer) { /* Arrange to go back to the original buffer once we're done processing the key sequence. We don't use @@ -1573,7 +1573,7 @@ like in the respective argument of `key-binding'. */) record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (XBUFFER (WVAR (XWINDOW (window), buffer))); + set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); } } @@ -1854,7 +1854,7 @@ If KEYMAP is nil, that means no local keymap. */) if (!NILP (keymap)) keymap = get_keymap (keymap, 1, 1); - BVAR (current_buffer, keymap) = keymap; + BSET (current_buffer, keymap, keymap); return Qnil; } @@ -2069,7 +2069,7 @@ The `kbd' macro is an approximate inverse of this. */) size += XINT (Flength (prefix)); /* This has one extra element at the end that we don't pass to Fconcat. */ - if (min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object) / 4 < size) + if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size) memory_full (SIZE_MAX); SAFE_ALLOCA_LISP (args, size * 4); @@ -2304,11 +2304,10 @@ around function keys and event symbols. */) { if (NILP (no_angles)) { - char *buffer; Lisp_Object result; USE_SAFE_ALLOCA; - SAFE_ALLOCA (buffer, char *, - sizeof "<>" + SBYTES (SYMBOL_NAME (key))); + char *buffer = SAFE_ALLOCA (sizeof "<>" + + SBYTES (SYMBOL_NAME (key))); esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key))); result = build_string (buffer); SAFE_FREE (); diff --git a/src/lisp.h b/src/lisp.h index 526c754b5dd..90705f51ddb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -22,12 +22,18 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include #include +INLINE_HEADER_BEGIN +#ifndef LISP_INLINE +# define LISP_INLINE INLINE +#endif + /* The ubiquitous max and min macros. */ #undef min #undef max @@ -295,14 +301,14 @@ enum Lisp_Fwd_Type typedef struct { EMACS_INT i; } Lisp_Object; #define XLI(o) (o).i -static inline Lisp_Object +LISP_INLINE Lisp_Object XIL (EMACS_INT i) { Lisp_Object o = { i }; return o; } -static inline Lisp_Object +LISP_INLINE Lisp_Object LISP_MAKE_RVALUE (Lisp_Object o) { return o; @@ -326,11 +332,15 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = 0 }; /* In the size word of a vector, this bit means the vector has been marked. */ -static ptrdiff_t const ARRAY_MARK_FLAG = PTRDIFF_MIN; +static ptrdiff_t const ARRAY_MARK_FLAG +#define ARRAY_MARK_FLAG PTRDIFF_MIN + = ARRAY_MARK_FLAG; /* In the size word of a struct Lisp_Vector, this bit means it's really some other vector-like object. */ -static ptrdiff_t const PSEUDOVECTOR_FLAG = PTRDIFF_MAX - PTRDIFF_MAX / 2; +static ptrdiff_t const PSEUDOVECTOR_FLAG +#define PSEUDOVECTOR_FLAG (PTRDIFF_MAX - PTRDIFF_MAX / 2) + = PSEUDOVECTOR_FLAG; /* In a pseudovector, the size field actually contains a word with one PSEUDOVECTOR_FLAG bit set, and exactly one of the following bits to @@ -421,7 +431,9 @@ enum lsb_bits #else /* not USE_LSB_TAG */ -static EMACS_INT const VALMASK = VAL_MAX; +static EMACS_INT const VALMASK +#define VALMASK VAL_MAX + = VALMASK; #define XTYPE(a) ((enum Lisp_Type) ((EMACS_UINT) XLI (a) >> VALBITS)) @@ -485,7 +497,7 @@ static EMACS_INT const MOST_NEGATIVE_FIXNUM = #define FIXNUM_OVERFLOW_P(i) \ (! ((0 <= (i) || MOST_NEGATIVE_FIXNUM <= (i)) && (i) <= MOST_POSITIVE_FIXNUM)) -static inline ptrdiff_t +LISP_INLINE ptrdiff_t clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) { return num < lower ? lower : num <= upper ? num : upper; @@ -603,7 +615,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define ASET(ARRAY, IDX, VAL) \ (eassert ((IDX) == (IDX)), \ eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)), \ - AREF ((ARRAY), (IDX)) = (VAL)) + XVECTOR (ARRAY)->contents[IDX] = (VAL)) /* Convenience macros for dealing with Lisp strings. */ @@ -627,10 +639,7 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) #define CHECK_TYPE(ok, Qxxxp, x) \ do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) -/* Lisp fields are usually hidden from most code and accessed - via special macros. Only select pieces of code, like the GC, - are allowed to use INTERNAL_FIELD directly. Objects which - aren't using this convention should be fixed. */ +/* Deprecated and will be removed soon. */ #define INTERNAL_FIELD(field) field ## _ @@ -638,24 +647,19 @@ clip_to_bounds (ptrdiff_t lower, EMACS_INT num, ptrdiff_t upper) typedef struct interval *INTERVAL; -/* Complain if object is not string or buffer type */ +/* Complain if object is not string or buffer type. */ #define CHECK_STRING_OR_BUFFER(x) \ CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) -/* Most code should use this macro to - access Lisp fields in struct Lisp_Cons. */ - -#define CVAR(cons, field) ((cons)->INTERNAL_FIELD (field)) - struct Lisp_Cons { /* Car of this cons cell. */ - Lisp_Object INTERNAL_FIELD (car); + Lisp_Object car; union { /* Cdr of this cons cell. */ - Lisp_Object INTERNAL_FIELD (cdr); + Lisp_Object cdr; /* Used to chain conses on a free list. */ struct Lisp_Cons *chain; @@ -669,8 +673,8 @@ struct Lisp_Cons fields are not accessible as lvalues. (What if we want to switch to a copying collector someday? Cached cons cell field addresses may be invalidated at arbitrary points.) */ -#define XCAR_AS_LVALUE(c) (CVAR (XCONS (c), car)) -#define XCDR_AS_LVALUE(c) (CVAR (XCONS (c), u.cdr)) +#define XCAR_AS_LVALUE(c) (XCONS (c)->car) +#define XCDR_AS_LVALUE(c) (XCONS (c)->u.cdr) /* Use these from normal code. */ #define XCAR(c) LISP_MAKE_RVALUE (XCAR_AS_LVALUE (c)) @@ -754,12 +758,6 @@ static ptrdiff_t const STRING_BYTES_BOUND = (STR) = empty_multibyte_string; \ else XSTRING (STR)->size_byte = XSTRING (STR)->size; } while (0) -/* Get text properties. */ -#define STRING_INTERVALS(STR) (XSTRING (STR)->intervals + 0) - -/* Set text properties. */ -#define STRING_SET_INTERVALS(STR, INT) (XSTRING (STR)->intervals = (INT)) - /* In a string or vector, the sign bit of the `size' is the gc mark bit. */ struct Lisp_String @@ -818,25 +816,49 @@ struct vectorlike_header } next; }; +/* Regular vector is just a header plus array of Lisp_Objects. */ + struct Lisp_Vector { struct vectorlike_header header; Lisp_Object contents[1]; }; +/* A boolvector is a kind of vectorlike, with contents are like a string. */ + +struct Lisp_Bool_Vector + { + /* HEADER.SIZE is the vector's size field. It doesn't have the real size, + just the subtype information. */ + struct vectorlike_header header; + /* This is the size in bits. */ + EMACS_INT size; + /* This contains the actual bits, packed into bytes. */ + unsigned char data[1]; + }; + +/* Some handy constants for calculating sizes + and offsets, mostly of vectorlike objects. */ + +enum + { + header_size = offsetof (struct Lisp_Vector, contents), + bool_header_size = offsetof (struct Lisp_Bool_Vector, data), + word_size = sizeof (Lisp_Object) + }; + /* If a struct is made to look like a vector, this macro returns the length of the shortest vector that would hold that struct. */ -#define VECSIZE(type) ((sizeof (type) \ - - offsetof (struct Lisp_Vector, contents[0]) \ - + sizeof (Lisp_Object) - 1) /* Round up. */ \ - / sizeof (Lisp_Object)) + +#define VECSIZE(type) \ + ((sizeof (type) - header_size + word_size - 1) / word_size) /* Like VECSIZE, but used when the pseudo-vector has non-Lisp_Object fields at the end and we need to compute the number of Lisp_Object fields (the ones that the GC needs to trace). */ -#define PSEUDOVECSIZE(type, nonlispfield) \ - ((offsetof (type, nonlispfield) - offsetof (struct Lisp_Vector, contents[0])) \ - / sizeof (Lisp_Object)) + +#define PSEUDOVECSIZE(type, nonlispfield) \ + ((offsetof (type, nonlispfield) - header_size) / word_size) /* A char-table is a kind of vectorlike, with contents are like a vector but with a few other slots. For some purposes, it makes @@ -972,18 +994,6 @@ struct Lisp_Sub_Char_Table Lisp_Object contents[1]; }; -/* A boolvector is a kind of vectorlike, with contents are like a string. */ -struct Lisp_Bool_Vector - { - /* HEADER.SIZE is the vector's size field. It doesn't have the real size, - just the subtype information. */ - struct vectorlike_header header; - /* This is the size in bits. */ - EMACS_INT size; - /* This contains the actual bits, packed into bytes. */ - unsigned char data[1]; - }; - /* This structure describes a built-in function. It is generated by the DEFUN macro only. defsubr makes it into a Lisp object. @@ -1049,11 +1059,6 @@ enum symbol_redirect SYMBOL_FORWARDED = 3 }; -/* Most code should use this macro to access - Lisp fields in struct Lisp_Symbol. */ - -#define SVAR(sym, field) ((sym)->INTERNAL_FIELD (field)) - struct Lisp_Symbol { unsigned gcmarkbit : 1; @@ -1078,25 +1083,23 @@ struct Lisp_Symbol special (with `defvar' etc), and shouldn't be lexically bound. */ unsigned declared_special : 1; - /* The symbol's name, as a Lisp string. - The name "xname" is used to intentionally break code referring to - the old field "name" of type pointer to struct Lisp_String. */ - Lisp_Object INTERNAL_FIELD (xname); + /* The symbol's name, as a Lisp string. */ + Lisp_Object name; /* Value of the symbol or Qunbound if unbound. Which alternative of the union is used depends on the `redirect' field above. */ union { - Lisp_Object INTERNAL_FIELD (value); + Lisp_Object value; struct Lisp_Symbol *alias; struct Lisp_Buffer_Local_Value *blv; union Lisp_Fwd *fwd; } val; /* Function value of the symbol or Qunbound if not fboundp. */ - Lisp_Object INTERNAL_FIELD (function); + Lisp_Object function; /* The symbol's property list. */ - Lisp_Object INTERNAL_FIELD (plist); + Lisp_Object plist; /* Next symbol in obarray bucket, if the symbol is interned. */ struct Lisp_Symbol *next; @@ -1104,43 +1107,42 @@ struct Lisp_Symbol /* Value is name of symbol. */ -#define SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), SVAR (sym, val.value)) -#define SYMBOL_ALIAS(sym) \ +#define SYMBOL_VAL(sym) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), sym->val.value) +#define SYMBOL_ALIAS(sym) \ (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias) -#define SYMBOL_BLV(sym) \ +#define SYMBOL_BLV(sym) \ (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv) -#define SYMBOL_FWD(sym) \ +#define SYMBOL_FWD(sym) \ (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd) -#define SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), SVAR (sym, val.value) = (v)) -#define SET_SYMBOL_ALIAS(sym, v) \ +#define SET_SYMBOL_VAL(sym, v) \ + (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) +#define SET_SYMBOL_ALIAS(sym, v) \ (eassert ((sym)->redirect == SYMBOL_VARALIAS), (sym)->val.alias = (v)) -#define SET_SYMBOL_BLV(sym, v) \ +#define SET_SYMBOL_BLV(sym, v) \ (eassert ((sym)->redirect == SYMBOL_LOCALIZED), (sym)->val.blv = (v)) -#define SET_SYMBOL_FWD(sym, v) \ +#define SET_SYMBOL_FWD(sym, v) \ (eassert ((sym)->redirect == SYMBOL_FORWARDED), (sym)->val.fwd = (v)) -#define SYMBOL_NAME(sym) \ - LISP_MAKE_RVALUE (SVAR (XSYMBOL (sym), xname)) +#define SYMBOL_NAME(sym) XSYMBOL (sym)->name /* Value is non-zero if SYM is an interned symbol. */ -#define SYMBOL_INTERNED_P(sym) \ - (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) +#define SYMBOL_INTERNED_P(sym) \ + (XSYMBOL (sym)->interned != SYMBOL_UNINTERNED) /* Value is non-zero if SYM is interned in initial_obarray. */ -#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ - (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) +#define SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P(sym) \ + (XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY) /* Value is non-zero if symbol is considered a constant, i.e. its value cannot be changed (there is an exception for keyword symbols, whose value can be set to the keyword symbol itself). */ -#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant +#define SYMBOL_CONSTANT_P(sym) XSYMBOL (sym)->constant -#define DEFSYM(sym, name) \ +#define DEFSYM(sym, name) \ do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (0) @@ -1265,16 +1267,11 @@ enum DEFAULT_HASH_SIZE { DEFAULT_HASH_SIZE = 65 }; value gives the ratio of current entries in the hash table and the size of the hash table. */ -#define DEFAULT_REHASH_THRESHOLD 0.8 +static double const DEFAULT_REHASH_THRESHOLD = 0.8; /* Default factor by which to increase the size of a hash table. */ -#define DEFAULT_REHASH_SIZE 1.5 - -/* Most code should use this macro to access - Lisp fields in a different misc objects. */ - -#define MVAR(misc, field) ((misc)->INTERNAL_FIELD (field)) +static double const DEFAULT_REHASH_SIZE = 1.5; /* These structures are used for various misc types. */ @@ -1345,9 +1342,9 @@ struct Lisp_Overlay unsigned gcmarkbit : 1; int spacer : 15; struct Lisp_Overlay *next; - Lisp_Object INTERNAL_FIELD (start); - Lisp_Object INTERNAL_FIELD (end); - Lisp_Object INTERNAL_FIELD (plist); + Lisp_Object start; + Lisp_Object end; + Lisp_Object plist; }; /* Hold a C pointer for later use. @@ -1403,7 +1400,7 @@ struct Lisp_Intfwd struct Lisp_Boolfwd { enum Lisp_Fwd_Type type; /* = Lisp_Fwd_Bool */ - int *boolvar; + bool *boolvar; }; /* Forwarding pointer to a Lisp_Object variable. @@ -1769,7 +1766,7 @@ typedef struct { vchild, and hchild members are all nil. */ #define CHECK_LIVE_WINDOW(x) \ - CHECK_TYPE (WINDOWP (x) && !NILP (WVAR (XWINDOW (x), buffer)), \ + CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), \ Qwindow_live_p, x) #define CHECK_PROCESS(x) \ @@ -1938,7 +1935,7 @@ enum maxargs extern void defvar_lisp (struct Lisp_Objfwd *, const char *, Lisp_Object *); extern void defvar_lisp_nopro (struct Lisp_Objfwd *, const char *, Lisp_Object *); -extern void defvar_bool (struct Lisp_Boolfwd *, const char *, int *); +extern void defvar_bool (struct Lisp_Boolfwd *, const char *, bool *); extern void defvar_int (struct Lisp_Intfwd *, const char *, EMACS_INT *); extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); @@ -2341,6 +2338,104 @@ void staticpro (Lisp_Object *); struct window; struct frame; +/* Simple access functions. */ + +LISP_INLINE Lisp_Object * +aref_addr (Lisp_Object array, ptrdiff_t idx) +{ + return & XVECTOR (array)->contents[idx]; +} + +LISP_INLINE void +gc_aset (Lisp_Object array, ptrdiff_t idx, Lisp_Object val) +{ + /* Like ASET, but also can be used in the garbage collector: + sweep_weak_table calls set_hash_key etc. while the table is marked. */ + eassert (0 <= idx && idx < (ASIZE (array) & ~ARRAY_MARK_FLAG)); + XVECTOR (array)->contents[idx] = val; +} + +LISP_INLINE void +set_hash_key (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->key_and_value, 2 * idx, val); +} + +LISP_INLINE void +set_hash_value (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->key_and_value, 2 * idx + 1, val); +} + +LISP_INLINE void +set_hash_next (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->next, idx, val); +} + +LISP_INLINE void +set_hash_hash (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->hash, idx, val); +} + +LISP_INLINE void +set_hash_index (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) +{ + gc_aset (h->index, idx, val); +} + +/* Use these functions to set Lisp_Object + or pointer slots of struct Lisp_Symbol. */ + +LISP_INLINE void +set_symbol_name (Lisp_Object sym, Lisp_Object name) +{ + XSYMBOL (sym)->name = name; +} + +LISP_INLINE void +set_symbol_function (Lisp_Object sym, Lisp_Object function) +{ + XSYMBOL (sym)->function = function; +} + +LISP_INLINE void +set_symbol_plist (Lisp_Object sym, Lisp_Object plist) +{ + XSYMBOL (sym)->plist = plist; +} + +LISP_INLINE void +set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) +{ + XSYMBOL (sym)->next = next; +} + +/* Set overlay's property list. */ + +LISP_INLINE void +set_overlay_plist (Lisp_Object overlay, Lisp_Object plist) +{ + XOVERLAY (overlay)->plist = plist; +} + +/* Get text properties of S. */ + +LISP_INLINE INTERVAL +string_get_intervals (Lisp_Object s) +{ + return XSTRING (s)->intervals; +} + +/* Set text properties of S to I. */ + +LISP_INLINE void +string_set_intervals (Lisp_Object s, INTERVAL i) +{ + XSTRING (s)->intervals = i; +} + /* Defined in data.c. */ extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; @@ -2659,7 +2754,7 @@ extern Lisp_Object make_unibyte_string (const char *, ptrdiff_t); /* Make unibyte string from C string when the length isn't known. */ -static inline Lisp_Object +LISP_INLINE Lisp_Object build_unibyte_string (const char *str) { return make_unibyte_string (str, strlen (str)); @@ -2677,7 +2772,7 @@ extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); /* Make a string allocated in pure space, use STR as string data. */ -static inline Lisp_Object +LISP_INLINE Lisp_Object build_pure_c_string (const char *str) { return make_pure_c_string (str, strlen (str)); @@ -2686,7 +2781,7 @@ build_pure_c_string (const char *str) /* Make a string from the data at STR, treating it as multibyte if the data warrants. */ -static inline Lisp_Object +LISP_INLINE Lisp_Object build_string (const char *str) { return make_string (str, strlen (str)); @@ -2805,13 +2900,13 @@ extern void init_obarray (void); extern void init_lread (void); extern void syms_of_lread (void); -static inline Lisp_Object +LISP_INLINE Lisp_Object intern (const char *str) { return intern_1 (str, strlen (str)); } -static inline Lisp_Object +LISP_INLINE Lisp_Object intern_c_string (const char *str) { return intern_c_string_1 (str, strlen (str)); @@ -2863,7 +2958,9 @@ extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_ extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_1 (Lisp_Object (*) (Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); extern Lisp_Object internal_condition_case_2 (Lisp_Object (*) (Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object (*) (Lisp_Object)); -extern Lisp_Object internal_condition_case_n (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, Lisp_Object, Lisp_Object (*) (Lisp_Object)); +extern Lisp_Object internal_condition_case_n + (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *, + Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *)); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object); @@ -3037,7 +3134,7 @@ extern int indented_beyond_p (ptrdiff_t, ptrdiff_t, EMACS_INT); extern void syms_of_indent (void); /* Defined in frame.c. */ -extern Lisp_Object Qonly; +extern Lisp_Object Qonly, Qnone; extern Lisp_Object Qvisible; extern void store_frame_param (struct frame *, Lisp_Object, Lisp_Object); extern void store_in_alist (Lisp_Object *, Lisp_Object, Lisp_Object); @@ -3327,23 +3424,6 @@ extern char *egetenv (const char *); /* Set up the name of the machine we're running on. */ extern void init_system_name (void); -static char const DIRECTORY_SEP = '/'; - -/* Use this to suppress gcc's warnings. */ -#ifdef lint - -/* Use CODE only if lint checking is in effect. */ -# define IF_LINT(Code) Code - -/* Assume that the expression COND is true. This differs in intent - from 'assert', as it is a message from the programmer to the compiler. */ -# define lint_assume(cond) ((cond) ? (void) 0 : abort ()) - -#else -# define IF_LINT(Code) /* empty */ -# define lint_assume(cond) ((void) (0 && (cond))) -#endif - /* We used to use `abs', but that clashes with system headers on some platforms, and using a name reserved by Standard C is a bad idea anyway. */ @@ -3389,24 +3469,16 @@ static char const DIRECTORY_SEP = '/'; enum MAX_ALLOCA { MAX_ALLOCA = 16*1024 }; extern Lisp_Object safe_alloca_unwind (Lisp_Object); +extern void *record_xmalloc (size_t); #define USE_SAFE_ALLOCA \ ptrdiff_t sa_count = SPECPDL_INDEX (); int sa_must_free = 0 /* SAFE_ALLOCA allocates a simple buffer. */ -#define SAFE_ALLOCA(buf, type, size) \ - do { \ - if ((size) < MAX_ALLOCA) \ - buf = (type) alloca (size); \ - else \ - { \ - buf = xmalloc (size); \ - sa_must_free = 1; \ - record_unwind_protect (safe_alloca_unwind, \ - make_save_value (buf, 0)); \ - } \ - } while (0) +#define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \ + ? alloca (size) \ + : (sa_must_free = 1, record_xmalloc (size))) /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER * NITEMS items, each of the same type as *BUF. MULTIPLIER must @@ -3438,21 +3510,21 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object); /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects. */ -#define SAFE_ALLOCA_LISP(buf, nelt) \ - do { \ - if ((nelt) < MAX_ALLOCA / sizeof (Lisp_Object)) \ - buf = (Lisp_Object *) alloca ((nelt) * sizeof (Lisp_Object)); \ - else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / sizeof (Lisp_Object)) \ - { \ - Lisp_Object arg_; \ - buf = xmalloc ((nelt) * sizeof (Lisp_Object)); \ - arg_ = make_save_value (buf, nelt); \ - XSAVE_VALUE (arg_)->dogc = 1; \ - sa_must_free = 1; \ - record_unwind_protect (safe_alloca_unwind, arg_); \ - } \ - else \ - memory_full (SIZE_MAX); \ +#define SAFE_ALLOCA_LISP(buf, nelt) \ + do { \ + if ((nelt) < MAX_ALLOCA / word_size) \ + buf = alloca ((nelt) * word_size); \ + else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \ + { \ + Lisp_Object arg_; \ + buf = xmalloc ((nelt) * word_size); \ + arg_ = make_save_value (buf, nelt); \ + XSAVE_VALUE (arg_)->dogc = 1; \ + sa_must_free = 1; \ + record_unwind_protect (safe_alloca_unwind, arg_); \ + } \ + else \ + memory_full (SIZE_MAX); \ } while (0) @@ -3460,7 +3532,7 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object); /* Check whether it's time for GC, and run it if so. */ -static inline void +LISP_INLINE void maybe_gc (void) { if ((consing_since_gc > gc_cons_threshold @@ -3470,4 +3542,6 @@ maybe_gc (void) Fgarbage_collect (); } +INLINE_HEADER_END + #endif /* EMACS_LISP_H */ diff --git a/src/lread.c b/src/lread.c index 8a9547ee579..72991e92bae 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3189,7 +3189,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Check for text properties in each interval. substitute_in_interval contains part of the logic. */ - INTERVAL root_interval = STRING_INTERVALS (subtree); + INTERVAL root_interval = string_get_intervals (subtree); Lisp_Object arg = Fcons (object, placeholder); traverse_intervals_noorder (root_interval, @@ -3211,7 +3211,7 @@ substitute_in_interval (INTERVAL interval, Lisp_Object arg) Lisp_Object object = Fcar (arg); Lisp_Object placeholder = Fcdr (arg); - SUBSTITUTE (interval->plist, interval->plist = true_value); + SUBSTITUTE (interval->plist, interval_set_plist (interval, true_value)); } @@ -3715,11 +3715,11 @@ it defaults to the value of `obarray'. */) SET_SYMBOL_VAL (XSYMBOL (sym), sym); } - ptr = &AREF (obarray, XINT(tem)); + ptr = aref_addr (obarray, XINT(tem)); if (SYMBOLP (*ptr)) - XSYMBOL (sym)->next = XSYMBOL (*ptr); + set_symbol_next (sym, XSYMBOL (*ptr)); else - XSYMBOL (sym)->next = 0; + set_symbol_next (sym, NULL); *ptr = sym; return sym; } @@ -3797,9 +3797,13 @@ OBARRAY defaults to the value of the variable `obarray'. */) if (EQ (AREF (obarray, hash), tem)) { if (XSYMBOL (tem)->next) - XSETSYMBOL (AREF (obarray, hash), XSYMBOL (tem)->next); + { + Lisp_Object sym; + XSETSYMBOL (sym, XSYMBOL (tem)->next); + ASET (obarray, hash, sym); + } else - XSETINT (AREF (obarray, hash), 0); + ASET (obarray, hash, make_number (0)); } else { @@ -3812,7 +3816,7 @@ OBARRAY defaults to the value of the variable `obarray'. */) XSETSYMBOL (following, XSYMBOL (tail)->next); if (EQ (following, tem)) { - XSYMBOL (tail)->next = XSYMBOL (following)->next; + set_symbol_next (tail, XSYMBOL (following)->next); break; } } @@ -3922,13 +3926,12 @@ init_obarray (void) /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, so those two need to be fixed manually. */ SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); - SVAR (XSYMBOL (Qunbound), function) = Qunbound; - SVAR (XSYMBOL (Qunbound), plist) = Qnil; - /* XSYMBOL (Qnil)->function = Qunbound; */ + set_symbol_function (Qunbound, Qunbound); + set_symbol_plist (Qunbound, Qnil); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); XSYMBOL (Qnil)->constant = 1; XSYMBOL (Qnil)->declared_special = 1; - SVAR (XSYMBOL (Qnil), plist) = Qnil; + set_symbol_plist (Qnil, Qnil); Qt = intern_c_string ("t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); @@ -3947,10 +3950,11 @@ init_obarray (void) void defsubr (struct Lisp_Subr *sname) { - Lisp_Object sym; + Lisp_Object sym, tem; sym = intern_c_string (sname->symbol_name); XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR); - XSETSUBR (SVAR (XSYMBOL (sym), function), sname); + XSETSUBR (tem, sname); + set_symbol_function (sym, tem); } #ifdef NOTDEF /* Use fset in subr.el now! */ @@ -3983,7 +3987,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd, nil if address contains 0. */ void defvar_bool (struct Lisp_Boolfwd *b_fwd, - const char *namestring, int *address) + const char *namestring, bool *address) { Lisp_Object sym; sym = intern_c_string (namestring); @@ -4127,7 +4131,7 @@ init_lread (void) sitelisp = decode_env_path (0, PATH_SITELOADSEARCH); if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path); } -#else +#else /* !CANNOT_DUMP */ if (NILP (Vpurify_flag)) { normal = PATH_LOADSEARCH; @@ -4289,7 +4293,7 @@ init_lread (void) be missing unless something went extremely (and improbably) wrong, in which case the build will fail in obvious ways. */ } -#endif /* CANNOT_DUMP */ +#endif /* !CANNOT_DUMP */ Vvalues = Qnil; @@ -4313,12 +4317,10 @@ dir_warning (const char *format, Lisp_Object dirname) /* Don't log the warning before we've initialized!! */ if (initialized) { - char *buffer; - ptrdiff_t message_len; USE_SAFE_ALLOCA; - SAFE_ALLOCA (buffer, char *, - SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1); - message_len = esprintf (buffer, format, SDATA (dirname)); + char *buffer = SAFE_ALLOCA (SBYTES (dirname) + + strlen (format) - (sizeof "%s" - 1) + 1); + ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname)); message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname)); SAFE_FREE (); } @@ -4539,8 +4541,7 @@ to load. See also `load-dangerous-libraries'. */); Vbytecomp_version_regexp = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); - Qlexical_binding = intern ("lexical-binding"); - staticpro (&Qlexical_binding); + DEFSYM (Qlexical_binding, "lexical-binding"); DEFVAR_LISP ("lexical-binding", Vlexical_binding, doc: /* Whether to use lexical binding when evaluating code. Non-nil means that the code in the current buffer should be evaluated @@ -4548,6 +4549,7 @@ with lexical binding. This variable is automatically set from the file variables of an interpreted Lisp file read using `load'. Unlike other file local variables, this must be set in the first line of a file. */); + Vlexical_binding = Qnil; Fmake_variable_buffer_local (Qlexical_binding); DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, diff --git a/src/macros.c b/src/macros.c index 0b1eda0b8ab..d74d12e6158 100644 --- a/src/macros.c +++ b/src/macros.c @@ -63,7 +63,7 @@ macro before appending to it. */) if (!current_kboard->kbd_macro_buffer) { - current_kboard->kbd_macro_buffer = xmalloc (30 * sizeof (Lisp_Object)); + current_kboard->kbd_macro_buffer = xmalloc (30 * word_size); current_kboard->kbd_macro_bufsize = 30; } update_mode_lines++; @@ -72,8 +72,8 @@ macro before appending to it. */) if (current_kboard->kbd_macro_bufsize > 200) { current_kboard->kbd_macro_buffer - = (Lisp_Object *)xrealloc (current_kboard->kbd_macro_buffer, - 30 * sizeof (Lisp_Object)); + = xrealloc (current_kboard->kbd_macro_buffer, + 30 * word_size); current_kboard->kbd_macro_bufsize = 30; } current_kboard->kbd_macro_ptr = current_kboard->kbd_macro_buffer; @@ -127,7 +127,7 @@ macro before appending to it. */) message ("Appending to kbd macro..."); } - KVAR (current_kboard, defining_kbd_macro) = Qt; + KSET (current_kboard, defining_kbd_macro, Qt); return Qnil; } @@ -137,12 +137,12 @@ macro before appending to it. */) void end_kbd_macro (void) { - KVAR (current_kboard, defining_kbd_macro) = Qnil; + KSET (current_kboard, defining_kbd_macro, Qnil); update_mode_lines++; - KVAR (current_kboard, Vlast_kbd_macro) - = make_event_array ((current_kboard->kbd_macro_end - - current_kboard->kbd_macro_buffer), - current_kboard->kbd_macro_buffer); + KSET (current_kboard, Vlast_kbd_macro, + make_event_array ((current_kboard->kbd_macro_end + - current_kboard->kbd_macro_buffer), + current_kboard->kbd_macro_buffer)); } DEFUN ("end-kbd-macro", Fend_kbd_macro, Send_kbd_macro, 0, 2, "p", @@ -330,7 +330,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) executing_kbd_macro = final; executing_kbd_macro_index = 0; - KVAR (current_kboard, Vprefix_arg) = Qnil; + KSET (current_kboard, Vprefix_arg, Qnil); if (!NILP (loopfunc)) { diff --git a/src/makefile.w32-in b/src/makefile.w32-in index ee5424cf757..31dc94f7964 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -339,7 +339,7 @@ cleanall: clean ## ## This works only with GNU Make. -TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/s/ms-w32.h +TAGS: $(OBJ0) $(OBJ1) $(OBJ2) $(CURDIR)/../nt/inc/ms-w32.h $(MAKE) $(MFLAGS) TAGS-$(MAKETYPE) TAGS-LISP: $(OBJ0) $(OBJ1) $(OBJ2) @@ -353,7 +353,7 @@ TAGS-gmake: $(OBJ1_c) ../lib-src/$(BLD)/etags.exe -a --regex=@../nt/emacs-src.tags \ $(OBJ2_c) \ - $(CURDIR)/*.h $(CURDIR)/s/ms-w32.h + $(CURDIR)/*.h $(CURDIR)/../nt/inc/ms-w32.h TAGS-nmake: echo This target is not supported with NMake @@ -403,7 +403,7 @@ CHARSET_H = $(SRC)/charset.h \ $(GNU_LIB)/verify.h CODING_H = $(SRC)/coding.h \ $(SRC)/composite.h -MS_W32_H = $(SRC)/s/ms-w32.h \ +MS_W32_H = $(NT_INC)/ms-w32.h \ $(NT_INC)/sys/stat.h CONF_POST_H = $(SRC)/conf_post.h \ $(MS_W32_H) diff --git a/src/menu.c b/src/menu.c index 3b8ebb65d2c..3e466b46aa3 100644 --- a/src/menu.c +++ b/src/menu.c @@ -976,8 +976,7 @@ find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data) prefix = entry = Qnil; i = 0; - subprefix_stack = - (Lisp_Object *)alloca (menu_items_used * sizeof (Lisp_Object)); + subprefix_stack = alloca (menu_items_used * word_size); while (i < menu_items_used) { @@ -1006,7 +1005,7 @@ find_and_return_menu_selection (FRAME_PTR f, int keymaps, void *client_data) { entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); - if (&AREF (menu_items, i) == client_data) + if (aref_addr (menu_items, i) == client_data) { if (keymaps != 0) { diff --git a/src/minibuf.c b/src/minibuf.c index 4b9c0a32f85..06ea415db62 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -102,23 +102,25 @@ choose_minibuf_frame (void) { if (FRAMEP (selected_frame) && FRAME_LIVE_P (XFRAME (selected_frame)) - && !EQ (minibuf_window, FVAR (XFRAME (selected_frame), minibuffer_window))) + && !EQ (minibuf_window, XFRAME (selected_frame)->minibuffer_window)) { struct frame *sf = XFRAME (selected_frame); Lisp_Object buffer; /* I don't think that any frames may validly have a null minibuffer window anymore. */ - if (NILP (FVAR (sf, minibuffer_window))) + if (NILP (sf->minibuffer_window)) abort (); /* Under X, we come here with minibuf_window being the minibuffer window of the unused termcap window created in init_window_once. That window doesn't have a buffer. */ - buffer = WVAR (XWINDOW (minibuf_window), buffer); + buffer = XWINDOW (minibuf_window)->buffer; if (BUFFERP (buffer)) - Fset_window_buffer (FVAR (sf, minibuffer_window), buffer, Qnil); - minibuf_window = FVAR (sf, minibuffer_window); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (sf->minibuffer_window, buffer, 0, 0); + minibuf_window = sf->minibuffer_window; } /* Make sure no other frame has a minibuffer as its selected window, @@ -264,7 +266,7 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial, if (STRING_BYTES_BOUND / 2 < size) memory_full (SIZE_MAX); size *= 2; - line = (char *) xrealloc (line, size); + line = xrealloc (line, size); } line[len++] = c; } @@ -406,6 +408,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object dummy, frame; specbind (Qminibuffer_default, defalt); + specbind (intern ("inhibit-read-only"), Qnil); /* If Vminibuffer_completing_file_name is `lambda' on entry, it was t in previous recursive minibuffer, but was not set explicitly @@ -562,11 +565,11 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* Defeat (setq-default truncate-lines t), since truncated lines do not work correctly in minibuffers. (Bug#5715, etc) */ - BVAR (current_buffer, truncate_lines) = Qnil; + BSET (current_buffer, truncate_lines, Qnil); /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ if (inherit_input_method) - BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte; + BSET (current_buffer, enable_multibyte_characters, enable_multibyte); /* The current buffer's default directory is usually the right thing for our minibuffer here. However, if you're typing a command at @@ -577,7 +580,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, you think of something better to do? Find another buffer with a better directory, and use that one instead. */ if (STRINGP (ambient_dir)) - BVAR (current_buffer, directory) = ambient_dir; + BSET (current_buffer, directory, ambient_dir); else { Lisp_Object buf_list; @@ -591,7 +594,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, other_buf = XCDR (XCAR (buf_list)); if (STRINGP (BVAR (XBUFFER (other_buf), directory))) { - BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory); + BSET (current_buffer, directory, + BVAR (XBUFFER (other_buf), directory)); break; } } @@ -612,15 +616,19 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, FOR_EACH_FRAME (dummy, frame) { Lisp_Object root_window = Fframe_root_window (frame); - Lisp_Object mini_window = WVAR (XWINDOW (root_window), next); + Lisp_Object mini_window = XWINDOW (root_window)->next; if (! NILP (mini_window) && ! EQ (mini_window, minibuf_window) && !NILP (Fwindow_minibuffer_p (mini_window))) - Fset_window_buffer (mini_window, empty_minibuf, Qnil); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (mini_window, empty_minibuf, 0, 0); } /* Display this minibuffer in the proper window. */ - Fset_window_buffer (minibuf_window, Fcurrent_buffer (), Qnil); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (minibuf_window, Fcurrent_buffer (), 0, 0); Fselect_window (minibuf_window, Qnil); XWINDOW (minibuf_window)->hscroll = 0; @@ -664,7 +672,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, } clear_message (1, 1); - BVAR (current_buffer, keymap) = map; + BSET (current_buffer, keymap, map); /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) @@ -673,7 +681,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Frun_hooks (1, &Qminibuffer_setup_hook); /* Don't allow the user to undo past this point. */ - BVAR (current_buffer, undo_list) = Qnil; + BSET (current_buffer, undo_list, Qnil); recursive_edit_1 (); @@ -687,7 +695,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, XWINDOW (minibuf_window)->must_be_updated_p = 1; update_frame (XFRAME (selected_frame), 1, 1); { - struct frame *f = XFRAME (WVAR (XWINDOW (minibuf_window), frame)); + struct frame *f = XFRAME (XWINDOW (minibuf_window)->frame); struct redisplay_interface *rif = FRAME_RIF (f); if (rif && rif->flush_display) rif->flush_display (f); @@ -844,7 +852,7 @@ read_minibuf_unwind (Lisp_Object data) window = minibuf_window; /* To keep things predictable, in case it matters, let's be in the minibuffer when we reset the relevant variables. */ - Fset_buffer (WVAR (XWINDOW (window), buffer)); + Fset_buffer (XWINDOW (window)->buffer); /* Restore prompt, etc, from outer minibuffer level. */ minibuf_prompt = Fcar (minibuf_save_list); diff --git a/src/msdos.c b/src/msdos.c index d6a493a71d3..bcb7fbe75e0 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1594,9 +1594,9 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist) Lisp_Object tail; int i, j, length = XINT (Flength (alist)); Lisp_Object *parms - = (Lisp_Object *) alloca (length * sizeof (Lisp_Object)); + = (Lisp_Object *) alloca (length * word_size); Lisp_Object *values - = (Lisp_Object *) alloca (length * sizeof (Lisp_Object)); + = (Lisp_Object *) alloca (length * word_size); /* Do we have to reverse the foreground and background colors? */ int reverse = EQ (Fcdr (Fassq (Qreverse, f->param_alist)), Qt); int redraw = 0, fg_set = 0, bg_set = 0; @@ -1801,7 +1801,7 @@ internal_terminal_init (void) } tty = FRAME_TTY (sf); - KVAR (current_kboard, Vwindow_system) = Qpc; + KSET (current_kboard, Vwindow_system, Qpc); sf->output_method = output_msdos_raw; if (init_needed) { @@ -2435,9 +2435,9 @@ and then the scan code. */) { val = Fvector (NUM_RECENT_DOSKEYS, keys); memcpy (XVECTOR (val)->contents, keys + recent_doskeys_index, - (NUM_RECENT_DOSKEYS - recent_doskeys_index) * sizeof (Lisp_Object)); + (NUM_RECENT_DOSKEYS - recent_doskeys_index) * word_size); memcpy (XVECTOR (val)->contents + NUM_RECENT_DOSKEYS - recent_doskeys_index, - keys, recent_doskeys_index * sizeof (Lisp_Object)); + keys, recent_doskeys_index * word_size); return val; } } diff --git a/src/nsfns.m b/src/nsfns.m index 3de78c05c23..1b39f0257a5 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -82,7 +82,6 @@ Updated by Christian Limpach (chris@nice.ch) extern Lisp_Object Qunderline, Qundefined; extern Lisp_Object Qheight, Qminibuffer, Qname, Qonly, Qwidth; extern Lisp_Object Qunsplittable, Qmenu_bar_lines, Qbuffer_predicate, Qtitle; -extern Lisp_Object Qnone; Lisp_Object Qbuffered; @@ -448,16 +447,16 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side else if (!STRINGP (oldval) && EQ (oldval, Qnil) == EQ (arg, Qnil)) return; - FVAR (f, icon_name) = arg; + FSET (f, icon_name, arg); if (NILP (arg)) { - if (!NILP (FVAR (f, title))) - arg = FVAR (f, title); + if (!NILP (f->title)) + arg = f->title; else /* explicit name and no icon-name -> explicit_name */ if (f->explicit_name) - arg = FVAR (f, name); + arg = f->name; else { /* no explicit name and no icon-name -> @@ -496,10 +495,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side if (! [[[view window] title] isEqualToString: str]) [[view window] setTitle: str]; - if (!STRINGP (FVAR (f, icon_name))) + if (!STRINGP (f->icon_name)) encoded_icon_name = encoded_name; else - encoded_icon_name = ENCODE_UTF_8 (FVAR (f, icon_name)); + encoded_icon_name = ENCODE_UTF_8 (f->icon_name); str = [NSString stringWithUTF8String: SSDATA (encoded_icon_name)]; @@ -537,14 +536,14 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side CHECK_STRING (name); /* Don't change the name if it's already NAME. */ - if (! NILP (Fstring_equal (name, FVAR (f, name)))) + if (! NILP (Fstring_equal (name, f->name))) return; - FVAR (f, name) = name; + FSET (f, name, name); /* title overrides explicit name */ - if (! NILP (FVAR (f, title))) - name = FVAR (f, title); + if (! NILP (f->title)) + name = f->title; ns_set_name_internal (f, name); } @@ -586,15 +585,15 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side { NSTRACE (x_set_title); /* Don't change the title if it's already NAME. */ - if (EQ (name, FVAR (f, title))) + if (EQ (name, f->title)) return; update_mode_lines = 1; - FVAR (f, title) = name; + FSET (f, title, name); if (NILP (name)) - name = FVAR (f, name); + name = f->name; else CHECK_STRING (name); @@ -607,7 +606,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side { NSView *view; Lisp_Object name, filename; - Lisp_Object buf = XWINDOW (FVAR (f, selected_window))->buffer; + Lisp_Object buf = XWINDOW (f->selected_window)->buffer; const char *title; NSAutoreleasePool *pool; struct gcpro gcpro1; @@ -615,7 +614,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side NSString *str; NSTRACE (ns_set_name_as_filename); - if (f->explicit_name || ! NILP (FVAR (f, title)) || ns_in_resize) + if (f->explicit_name || ! NILP (f->title) || ns_in_resize) return; BLOCK_INPUT; @@ -677,7 +676,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side [[view window] setRepresentedFilename: fstr]; [[view window] setTitle: str]; - FVAR (f, name) = name; + FSET (f, name, name); } [pool release]; @@ -690,7 +689,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side { NSView *view = FRAME_NS_VIEW (f); NSAutoreleasePool *pool; - if (!MINI_WINDOW_P (XWINDOW (FVAR (f, selected_window)))) + if (!MINI_WINDOW_P (XWINDOW (f->selected_window))) { BLOCK_INPUT; pool = [[NSAutoreleasePool alloc] init]; @@ -777,7 +776,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side BLOCK_INPUT; pool = [[NSAutoreleasePool alloc] init]; if (f->output_data.ns->miniimage - && [[NSString stringWithUTF8String: SSDATA (FVAR (f, name))] + && [[NSString stringWithUTF8String: SSDATA (f->name)] isEqualToString: [(NSImage *)f->output_data.ns->miniimage name]]) { [pool release]; @@ -785,7 +784,7 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side return; } - tem = assq_no_quit (Qicon_type, FVAR (f, param_alist)); + tem = assq_no_quit (Qicon_type, f->param_alist); if (CONSP (tem) && ! NILP (XCDR (tem))) { [pool release]; @@ -799,17 +798,17 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side { elt = XCAR (chain); /* special case: 't' means go by file type */ - if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (FVAR (f, name))[0] == '/') + if (SYMBOLP (elt) && EQ (elt, Qt) && SSDATA (f->name)[0] == '/') { NSString *str - = [NSString stringWithUTF8String: SSDATA (FVAR (f, name))]; + = [NSString stringWithUTF8String: SSDATA (f->name)]; if ([[NSFileManager defaultManager] fileExistsAtPath: str]) image = [[[NSWorkspace sharedWorkspace] iconForFile: str] retain]; } else if (CONSP (elt) && STRINGP (XCAR (elt)) && STRINGP (XCDR (elt)) && - fast_string_match (XCAR (elt), FVAR (f, name)) >= 0) + fast_string_match (XCAR (elt), f->name) >= 0) { image = [EmacsImage allocInitFromFile: XCDR (elt)]; if (image == nil) @@ -1205,11 +1204,11 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side FRAME_FONTSET (f) = -1; - FVAR (f, icon_name) = x_get_arg (dpyinfo, parms, Qicon_name, - "iconName", "Title", - RES_TYPE_STRING); - if (! STRINGP (FVAR (f, icon_name))) - FVAR (f, icon_name) = Qnil; + FSET (f, icon_name, x_get_arg (dpyinfo, parms, Qicon_name, + "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name)) + FSET (f, icon_name, Qnil); FRAME_NS_DISPLAY_INFO (f) = dpyinfo; @@ -1232,12 +1231,12 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side be set. */ if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) { - FVAR (f, name) = build_string ([ns_app_name UTF8String]); + FSET (f, name, build_string ([ns_app_name UTF8String])); f->explicit_name = 0; } else { - FVAR (f, name) = name; + FSET (f, name, name); f->explicit_name = 1; specbind (Qx_resource_name, name); } @@ -1392,13 +1391,13 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side if (FRAME_HAS_MINIBUF_P (f) && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) - KVAR (kb, Vdefault_minibuffer_frame) = frame; + KSET (kb, Vdefault_minibuffer_frame, frame); /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ for (tem = parms; CONSP (tem); tem = XCDR (tem)) if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) - FVAR (f, param_alist) = Fcons (XCAR (tem), FVAR (f, param_alist)); + FSET (f, param_alist, Fcons (XCAR (tem), f->param_alist)); UNGCPRO; diff --git a/src/nsmenu.m b/src/nsmenu.m index 86ffeec2952..657b9306942 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -73,7 +73,6 @@ /* Nonzero means a menu is currently active. */ static int popup_activated_flag; -static NSModalSession popupSession; /* Nonzero means we are tracking and updating menus. */ static int trackingMenu; @@ -215,20 +214,20 @@ if (! NILP (Vlucid_menu_bar_dirty_flag)) call0 (Qrecompute_lucid_menubar); safe_run_hooks (Qmenu_bar_update_hook); - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); /* Now ready to go */ items = FRAME_MENU_BAR_ITEMS (f); /* Save the frame's previous menu bar contents data */ if (previous_menu_items_used) - memcpy (previous_items, &AREF (FVAR (f, menu_bar_vector), 0), + memcpy (previous_items, aref_addr (f->menu_bar_vector, 0), previous_menu_items_used * sizeof (Lisp_Object)); /* parse stage 1: extract from lisp */ save_menu_items (); - menu_items = FVAR (f, menu_bar_vector); + menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; submenu_start = alloca (ASIZE (items) * sizeof *submenu_start); submenu_end = alloca (ASIZE (items) * sizeof *submenu_end); @@ -341,7 +340,7 @@ } /* The menu items are different, so store them in the frame */ /* FIXME: this is not correct for single-submenu case */ - FVAR (f, menu_bar_vector) = menu_items; + FSET (f, menu_bar_vector, menu_items); f->menu_bar_items_used = menu_items_used; /* Calls restore_menu_items, etc., as they were outside */ @@ -939,8 +938,7 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f /* If this item has a null value, make the call_data null so that it won't display a box when the mouse is on it. */ - wv->call_data - = !NILP (def) ? (void *) &AREF (menu_items, i) : 0; + wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0; wv->enabled = !NILP (enable); if (NILP (type)) @@ -1041,7 +1039,7 @@ - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f /* update EmacsToolbar as in GtkUtils, build items list */ for (i = 0; i < f->n_tool_bar_items; ++i) { -#define TOOLPROP(IDX) AREF (FVAR (f, tool_bar_items), \ +#define TOOLPROP(IDX) AREF (f->tool_bar_items, \ i * TOOL_BAR_ITEM_NSLOTS + (IDX)) BOOL enabled_p = !NILP (TOOLPROP (TOOL_BAR_ITEM_ENABLED_P)); @@ -1366,8 +1364,6 @@ - (NSRect) frame { EmacsDialogPanel *panel = unwind_data->dialog; popup_activated_flag = 0; - [NSApp endModalSession: popupSession]; - [panel close]; [unwind_data->pool release]; [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; @@ -1453,7 +1449,7 @@ - (NSRect) frame unwind_data->pool = pool; unwind_data->dialog = dialog; - + record_unwind_protect (pop_down_menu, make_save_value (unwind_data, 0)); popup_activated_flag = 1; tem = [dialog runDialogAt: p]; @@ -1757,20 +1753,40 @@ void process_dialog (id window, Lisp_Object list) } + +- (void)timeout_handler: (NSTimer *)timedEntry +{ + timer_fired = 1; + [NSApp abortModal]; +} + - (Lisp_Object)runDialogAt: (NSPoint)p { - NSInteger ret; + NSInteger ret = 0; - /* initiate a session that will be ended by pop_down_menu */ - popupSession = [NSApp beginModalSessionForWindow: self]; - while (popup_activated_flag - && (ret = [NSApp runModalSession: popupSession]) - == NSRunContinuesResponse) + while (popup_activated_flag) { - /* Run this for timers.el, indep of atimers; might not return. - TODO: use return value to avoid calling every iteration. */ - timer_check (); - [NSThread sleepUntilDate: [NSDate dateWithTimeIntervalSinceNow: 0.1]]; + NSTimer *tmo = nil; + EMACS_TIME next_time = timer_check (); + + if (EMACS_TIME_VALID_P (next_time)) + { + double time = EMACS_TIME_TO_DOUBLE (next_time); + tmo = [NSTimer timerWithTimeInterval: time + target: self + selector: @selector (timeout_handler:) + userInfo: 0 + repeats: NO]; + [[NSRunLoop currentRunLoop] addTimer: tmo + forMode: NSModalPanelRunLoopMode]; + } + timer_fired = 0; + ret = [NSApp runModalForWindow: self]; + if (! timer_fired) + { + if (tmo != nil) [tmo invalidate]; /* Cancels timer */ + break; + } } { /* FIXME: BIG UGLY HACK!!! */ diff --git a/src/nsselect.m b/src/nsselect.m index a4d91dae1f2..e0bbfe58636 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -62,7 +62,7 @@ Updated by Christian Limpach (chris@nice.ch) if (EQ (sym, QPRIMARY)) return NXPrimaryPboard; if (EQ (sym, QSECONDARY)) return NXSecondaryPboard; if (EQ (sym, QTEXT)) return NSStringPboardType; - return [NSString stringWithUTF8String: SSDATA (XSYMBOL (sym)->xname)]; + return [NSString stringWithUTF8String: SSDATA (SYMBOL_NAME (sym))]; } static NSPasteboard * diff --git a/src/nsterm.h b/src/nsterm.h index b20621a53d7..94984b3d35e 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -56,7 +56,7 @@ along with GNU Emacs. If not, see . */ - (void)sendEvent: (NSEvent *)theEvent; - (void)showPreferencesWindow: (id)sender; - (BOOL) openFile: (NSString *)fileName; -- (void)fd_handler: (NSTimer *) fdEntry; +- (void)fd_handler: (id)unused; - (void)timeout_handler: (NSTimer *)timedEntry; - (BOOL)fulfillService: (NSString *)name withArg: (NSString *)arg; @end @@ -195,12 +195,14 @@ along with GNU Emacs. If not, see . */ NSTextField *title; NSMatrix *matrix; int rows, cols; + int timer_fired; } - initFromContents: (Lisp_Object)menu isQuestion: (BOOL)isQ; - addButton: (char *)str value: (Lisp_Object)val row: (int)row; - addString: (char *)str row: (int)row; - addSplit; - (Lisp_Object)runDialogAt: (NSPoint)p; +- (void)timeout_handler: (NSTimer *)timedEntry; @end #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 @@ -735,7 +737,6 @@ extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name, extern void nxatoms_of_nsselect (void); extern int ns_lisp_to_cursor_type (Lisp_Object arg); extern Lisp_Object ns_cursor_type_to_lisp (int arg); -extern Lisp_Object Qnone; extern void ns_set_name_as_filename (struct frame *f); extern void ns_set_doc_edited (struct frame *f, Lisp_Object arg); diff --git a/src/nsterm.m b/src/nsterm.m index f13ec2795ea..76e6ee8fb40 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -39,6 +39,10 @@ Updated by Christian Limpach (chris@nice.ch) #include #include +#ifdef HAVE_FCNTL_H +#include +#endif + #include "lisp.h" #include "blockinput.h" #include "sysselect.h" @@ -139,7 +143,7 @@ Updated by Christian Limpach (chris@nice.ch) }; static Lisp_Object Qmodifier_value; -Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone; +Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper; extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft; static Lisp_Object QUTF8_STRING; @@ -184,17 +188,20 @@ Updated by Christian Limpach (chris@nice.ch) static BOOL send_appdefined = YES; static NSEvent *last_appdefined_event = 0; static NSTimer *timed_entry = 0; -static NSTimer *fd_entry = nil; static NSTimer *scroll_repeat_entry = nil; -static fd_set select_readfds, t_readfds; -static int select_nfds; +static fd_set select_readfds, select_writefds; +enum { SELECT_HAVE_READ = 1, SELECT_HAVE_WRITE = 2, SELECT_HAVE_TMO = 4 }; +static int select_nfds = 0, select_valid = 0; +static EMACS_TIME select_timeout = { 0, 0 }; +static int selfds[2] = { -1, -1 }; +static pthread_mutex_t select_mutex; +static int apploopnr = 0; static NSAutoreleasePool *outerpool; static struct input_event *emacs_event = NULL; static struct input_event *q_event_ptr = NULL; static int n_emacs_events_pending = 0; static NSMutableArray *ns_pending_files, *ns_pending_service_names, *ns_pending_service_args; -static BOOL inNsSelect = 0; static BOOL ns_do_open_file = NO; /* Convert modifiers in a NeXTstep event to emacs style modifiers. */ @@ -252,15 +259,20 @@ Updated by Christian Limpach (chris@nice.ch) /* This is a piece of code which is common to all the event handling methods. Maybe it should even be a function. */ -#define EV_TRAILER(e) \ - { \ - XSETFRAME (emacs_event->frame_or_window, emacsframe); \ - if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \ - n_emacs_events_pending++; \ - kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \ - EVENT_INIT (*emacs_event); \ - ns_send_appdefined (-1); \ - } +#define EV_TRAILER(e) \ + { \ + XSETFRAME (emacs_event->frame_or_window, emacsframe); \ + if (e) emacs_event->timestamp = EV_TIMESTAMP (e); \ + if (q_event_ptr) \ + { \ + n_emacs_events_pending++; \ + kbd_buffer_store_event_hold (emacs_event, q_event_ptr); \ + } \ + else \ + kbd_buffer_store_event (emacs_event); \ + EVENT_INIT (*emacs_event); \ + ns_send_appdefined (-1); \ + } void x_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object); @@ -329,8 +341,7 @@ Updated by Christian Limpach (chris@nice.ch) NSString *binDir = [bundle bundlePath]; NSString *resourcePath, *resourcePaths; NSRange range; - BOOL onWindows = NO; /* FIXME determine this somehow */ - NSString *pathSeparator = onWindows ? @";" : @":"; + NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; NSFileManager *fileManager = [NSFileManager defaultManager]; NSArray *paths; NSEnumerator *pathEnum; @@ -377,8 +388,7 @@ Updated by Christian Limpach (chris@nice.ch) NSBundle *bundle = [NSBundle mainBundle]; NSString *resourceDir = [bundle resourcePath]; NSString *resourcePath, *resourcePaths; - BOOL onWindows = NO; /* FIXME determine this somehow */ - NSString *pathSeparator = onWindows ? @";" : @":"; + NSString *pathSeparator = [NSString stringWithFormat: @"%c", SEPCHAR]; NSFileManager *fileManager = [NSFileManager defaultManager]; BOOL isDir; NSArray *paths = [resourceDir stringsByAppendingPaths: @@ -669,7 +679,7 @@ Free a pool and temporary objects it refers to (callable from C) external (RIF) call; for one window called before update_end -------------------------------------------------------------------------- */ { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (WVAR (w, frame))); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); /* note: this fn is nearly identical in all terms */ if (!w->pseudo_window_p) @@ -1020,7 +1030,7 @@ Free a pool and temporary objects it refers to (callable from C) : dpyinfo->x_focus_frame); if (!FRAME_LIVE_P (dpyinfo->x_highlight_frame)) { - FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil; + FSET (dpyinfo->x_focus_frame, focus_frame, Qnil); dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame; } } @@ -1306,7 +1316,7 @@ Free a pool and temporary objects it refers to (callable from C) FRAME_PIXEL_HEIGHT (f) = pixelheight; /* SET_FRAME_GARBAGED (f); // this short-circuits expose call in drawRect */ - mark_window_cursors_off (XWINDOW (FVAR (f, root_window))); + mark_window_cursors_off (XWINDOW (f->root_window)); cancel_mouse_face (f); UNBLOCK_INPUT; @@ -2037,7 +2047,7 @@ Free a pool and temporary objects it refers to (callable from C) External (RIF): Insert or delete n lines at line vpos -------------------------------------------------------------------------- */ { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int x, y, width, height, from_y, to_y, bottom_y; NSTRACE (ns_scroll_run); @@ -2116,7 +2126,7 @@ Free a pool and temporary objects it refers to (callable from C) full-width rows stays visible in the internal border. Under NS this is drawn inside the fringes. */ if (windows_or_buffers_changed - && (f = XFRAME (WVAR (w, frame)), + && (f = XFRAME (w->frame), width = FRAME_INTERNAL_BORDER_WIDTH (f), width != 0) && (height = desired_row->visible_height, @@ -2125,8 +2135,8 @@ Free a pool and temporary objects it refers to (callable from C) int y = WINDOW_TO_FRAME_PIXEL_Y (w, max (0, desired_row->y)); /* Internal border is drawn below the tool bar. */ - if (WINDOWP (FVAR (f, tool_bar_window)) - && w == XWINDOW (FVAR (f, tool_bar_window))) + if (WINDOWP (f->tool_bar_window) + && w == XWINDOW (f->tool_bar_window)) y -= width; /* end copy from other terms */ @@ -3379,14 +3389,6 @@ overwriting cursor (usually when cursor on a tab) */ timed_entry = nil; } - /* Ditto for file descriptor poller */ - if (fd_entry) - { - [fd_entry invalidate]; - [fd_entry release]; - fd_entry = nil; - } - nxev = [NSEvent otherEventWithType: NSApplicationDefined location: NSMakePoint (0, 0) modifierFlags: 0 @@ -3404,7 +3406,6 @@ overwriting cursor (usually when cursor on a tab) */ } } - static int ns_read_socket (struct terminal *terminal, int expected, struct input_event *hold_quit) @@ -3468,24 +3469,14 @@ overwriting cursor (usually when cursor on a tab) */ /* Run and wait for events. We must always send one NX_APPDEFINED event to ourself, otherwise [NXApp run] will never exit. */ send_appdefined = YES; + ns_send_appdefined (-1); - /* If called via ns_select, this is called once with expected=1, - because we expect either the timeout or file descriptor activity. - In this case the first event through will either be real input or - one of these. read_avail_input() then calls once more with expected=0 - and in that case we need to return quickly if there is nothing. - If we're being called outside of that, it's also OK to return quickly - after one iteration through the event loop, since other terms do - this and emacs expects it. */ - if (!(inNsSelect && expected)) + if (++apploopnr != 1) { - /* Post an application defined event on the event queue. When this is - received the [NXApp run] will return, thus having processed all - events which are currently queued, if any. */ - ns_send_appdefined (-1); + abort (); } - [NSApp run]; + --apploopnr; } nevents = n_emacs_events_pending; @@ -3505,65 +3496,89 @@ overwriting cursor (usually when cursor on a tab) */ -------------------------------------------------------------------------- */ { int result; - double time; NSEvent *ev; - struct timespec select_timeout; + int k, nr = 0; + struct input_event event; + char c; /* NSTRACE (ns_select); */ - if (NSApp == nil || inNsSelect == 1 /* || ([NSApp isActive] == NO && - [NSApp nextEventMatchingMask:NSAnyEventMask untilDate:nil - inMode:NSDefaultRunLoopMode dequeue:NO] == nil) */) + for (k = 0; readfds && k < nfds+1; k++) + if (FD_ISSET(k, readfds)) ++nr; + + if (NSApp == nil + || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask); - /* Save file descriptor set, which gets overwritten in calls to select () - Note, this is called from process.c, and only readfds is ever set */ - if (readfds) + [outerpool release]; + outerpool = [[NSAutoreleasePool alloc] init]; + + + send_appdefined = YES; + if (nr > 0) { - memcpy (&select_readfds, readfds, sizeof (fd_set)); + pthread_mutex_lock (&select_mutex); select_nfds = nfds; + select_valid = 0; + if (readfds) + { + select_readfds = *readfds; + select_valid += SELECT_HAVE_READ; + } + if (writefds) + { + select_writefds = *writefds; + select_valid += SELECT_HAVE_WRITE; + } + + if (timeout) + { + select_timeout = *timeout; + select_valid += SELECT_HAVE_TMO; + } + + pthread_mutex_unlock (&select_mutex); + + /* Inform fd_handler that select should be called */ + c = 'g'; + write (selfds[1], &c, 1); + } + else if (nr == 0 && timeout) + { + /* No file descriptor, just a timeout, no need to wake fd_handler */ + double time = EMACS_TIME_TO_DOUBLE (*timeout); + timed_entry = [[NSTimer scheduledTimerWithTimeInterval: time + target: NSApp + selector: + @selector (timeout_handler:) + userInfo: 0 + repeats: NO] + retain]; + } + else /* No timeout and no file descriptors, can this happen? */ + { + /* Send appdefined so we exit from the loop */ + ns_send_appdefined (-1); } - else - select_nfds = 0; - /* Try an initial select for pending data on input files */ - select_timeout.tv_sec = select_timeout.tv_nsec = 0; - result = pselect (nfds, readfds, writefds, exceptfds, - &select_timeout, sigmask); - if (result) - return result; + EVENT_INIT (event); + BLOCK_INPUT; + emacs_event = &event; + if (++apploopnr != 1) + { + abort(); + } + [NSApp run]; + --apploopnr; + emacs_event = NULL; + if (nr > 0 && readfds) + { + c = 's'; + write (selfds[1], &c, 1); + } + UNBLOCK_INPUT; - /* if (!timeout || timed_entry || fd_entry) - fprintf (stderr, "assertion failed: timeout null or timed_entry/fd_entry non-null in ns_select\n"); */ - - /* set a timeout and run the main AppKit event loop while continuing - to monitor the files */ - time = EMACS_TIME_TO_DOUBLE (*timeout); - timed_entry = [[NSTimer scheduledTimerWithTimeInterval: time - target: NSApp - selector: @selector (timeout_handler:) - userInfo: 0 - repeats: YES] /* for safe removal */ - retain]; - - /* set a periodic task to try the pselect () again */ - fd_entry = [[NSTimer scheduledTimerWithTimeInterval: 0.1 - target: NSApp - selector: @selector (fd_handler:) - userInfo: 0 - repeats: YES] - retain]; - - /* Let Application dispatch events until it receives an event of the type - NX_APPDEFINED, which should only be sent by timeout_handler. - We tell read_avail_input() that input is "expected" because we do expect - either the timeout or fd handler to fire, and if they don't, the original - call from process.c that got us here expects us to wait until some input - comes. */ - inNsSelect = 1; - gobble_input (1); ev = last_appdefined_event; - inNsSelect = 0; if (ev) { @@ -3577,25 +3592,28 @@ We tell read_avail_input() that input is "expected" because we do expect if (t == -2) { /* The NX_APPDEFINED event we received was a timeout. */ - return 0; + result = 0; } else if (t == -1) { /* The NX_APPDEFINED event we received was the result of at least one real input event arriving. */ errno = EINTR; - return -1; + result = -1; } else { - /* Received back from pselect () in fd_handler; copy the results */ - if (readfds) - memcpy (readfds, &select_readfds, sizeof (fd_set)); - return t; + /* Received back from select () in fd_handler; copy the results */ + pthread_mutex_lock (&select_mutex); + if (readfds) *readfds = select_readfds; + if (writefds) *writefds = select_writefds; + if (timeout) *timeout = select_timeout; + pthread_mutex_unlock (&select_mutex); + result = t; } } - /* never reached, shut compiler up */ - return 0; + + return result; } @@ -3678,7 +3696,7 @@ We tell read_avail_input() that input is "expected" because we do expect { bar = XNS_SCROLL_BAR (window->vertical_scroll_bar); [bar removeFromSuperview]; - window->vertical_scroll_bar = Qnil; + WSET (window, vertical_scroll_bar, Qnil); } ns_clear_frame_area (f, sb_left, top, width, height); UNBLOCK_INPUT; @@ -3689,7 +3707,7 @@ We tell read_avail_input() that input is "expected" because we do expect { ns_clear_frame_area (f, sb_left, top, width, height); bar = [[EmacsScroller alloc] initFrame: r window: win]; - window->vertical_scroll_bar = make_save_value (bar, 0); + WSET (window, vertical_scroll_bar, make_save_value (bar, 0)); } else { @@ -3743,7 +3761,7 @@ We tell read_avail_input() that input is "expected" because we do expect NSTRACE (ns_redeem_scroll_bar); if (!NILP (window->vertical_scroll_bar)) { - bar =XNS_SCROLL_BAR (window->vertical_scroll_bar); + bar = XNS_SCROLL_BAR (window->vertical_scroll_bar); [bar reprieve]; } } @@ -4026,6 +4044,21 @@ static Lisp_Object ns_string_to_lispmod (const char *s) { baud_rate = 38400; Fset_input_interrupt_mode (Qnil); + + if (selfds[0] == -1) + { + if (pipe (selfds) == -1) + { + fprintf (stderr, "Failed to create pipe: %s\n", + emacs_strerror (errno)); + abort (); + } + + fcntl (selfds[0], F_SETFL, O_NONBLOCK|fcntl (selfds[0], F_GETFL)); + FD_ZERO (&select_readfds); + FD_ZERO (&select_writefds); + pthread_mutex_init (&select_mutex, NULL); + } ns_initialized = 1; } @@ -4041,6 +4074,11 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. return NULL; [NSApp setDelegate: NSApp]; + /* Start the select thread. */ + [NSThread detachNewThreadSelector:@selector (fd_handler:) + toTarget:NSApp + withObject:nil]; + /* debugging: log all notifications */ /* [[NSNotificationCenter defaultCenter] addObserver: NSApp selector: @selector (logNotification:) @@ -4053,7 +4091,7 @@ Needs to be here because ns_initialize_display_info () uses AppKit classes. terminal->kboard = xmalloc (sizeof *terminal->kboard); init_kboard (terminal->kboard); - KVAR (terminal->kboard, Vwindow_system) = Qns; + KSET (terminal->kboard, Vwindow_system, Qns); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. @@ -4450,11 +4488,20 @@ - (NSApplicationTerminateReply)applicationShouldTerminate: (id)sender return NSTerminateNow; /* just in case */ } +static int +not_in_argv (NSString *arg) +{ + int k; + const char *a = [arg UTF8String]; + for (k = 1; k < initial_argc; ++k) + if (strcmp (a, initial_argv[k]) == 0) return 0; + return 1; +} /* Notification from the Workspace to open a file */ - (BOOL)application: sender openFile: (NSString *)file { - if (ns_do_open_file) + if (ns_do_open_file || not_in_argv (file)) [ns_pending_files addObject: file]; return YES; } @@ -4463,7 +4510,7 @@ - (BOOL)application: sender openFile: (NSString *)file /* Open a file as a temporary file */ - (BOOL)application: sender openTempFile: (NSString *)file { - if (ns_do_open_file) + if (ns_do_open_file || not_in_argv (file)) [ns_pending_files addObject: file]; return YES; } @@ -4472,25 +4519,22 @@ - (BOOL)application: sender openTempFile: (NSString *)file /* Notification from the Workspace to open a file noninteractively (?) */ - (BOOL)application: sender openFileWithoutUI: (NSString *)file { - if (ns_do_open_file) + if (ns_do_open_file || not_in_argv (file)) [ns_pending_files addObject: file]; return YES; } - /* Notification from the Workspace to open multiple files */ - (void)application: sender openFiles: (NSArray *)fileList { - /* Don't open files from the command line, Cocoa parses the command line - wrong anyway, --option value tries to open value if --option is the last - option. */ - if (ns_do_open_file) - { - NSEnumerator *files = [fileList objectEnumerator]; - NSString *file; - while ((file = [files nextObject]) != nil) - [ns_pending_files addObject: file]; - } + NSEnumerator *files = [fileList objectEnumerator]; + NSString *file; + /* Don't open files from the command line unconditionally, + Cocoa parses the command line wrong, --option value tries to open value + if --option is the last option. */ + while ((file = [files nextObject]) != nil) + if (ns_do_open_file || not_in_argv (file)) + [ns_pending_files addObject: file]; [self replyToOpenOrPrint: NSApplicationDelegateReplySuccess]; @@ -4543,26 +4587,91 @@ - (void)timeout_handler: (NSTimer *)timedEntry ns_send_appdefined (-2); } -- (void)fd_handler: (NSTimer *) fdEntry +- (void)fd_handler:(id)unused /* -------------------------------------------------------------------------- Check data waiting on file descriptors and terminate if so -------------------------------------------------------------------------- */ { int result; - struct timespec select_timeout; + int waiting = 1, nfds; + char c; + + SELECT_TYPE readfds, writefds, *wfds; + EMACS_TIME timeout, *tmo; + /* NSTRACE (fd_handler); */ - if (select_nfds == 0) - return; - - memcpy (&t_readfds, &select_readfds, sizeof (fd_set)); - - select_timeout.tv_sec = select_timeout.tv_nsec = 0; - result = pselect (select_nfds, &t_readfds, NULL, NULL, &select_timeout, NULL); - if (result) + for (;;) { - memcpy (&select_readfds, &t_readfds, sizeof (fd_set)); - ns_send_appdefined (result); + if (waiting) + { + SELECT_TYPE fds; + + FD_SET (selfds[0], &fds); + result = select (selfds[0]+1, &fds, NULL, NULL, NULL); + if (result > 0) + { + read (selfds[0], &c, 1); + if (c == 'g') waiting = 0; + } + } + else + { + pthread_mutex_lock (&select_mutex); + nfds = select_nfds; + + if (select_valid & SELECT_HAVE_READ) + readfds = select_readfds; + else + FD_ZERO (&readfds); + + if (select_valid & SELECT_HAVE_WRITE) + { + writefds = select_writefds; + wfds = &writefds; + } + else + wfds = NULL; + if (select_valid & SELECT_HAVE_TMO) + { + timeout = select_timeout; + tmo = &timeout; + } + else + tmo = NULL; + + pthread_mutex_unlock (&select_mutex); + + FD_SET (selfds[0], &readfds); + if (selfds[0] >= nfds) nfds = selfds[0]+1; + + result = pselect (nfds, &readfds, wfds, NULL, tmo, NULL); + + if (result == 0) + ns_send_appdefined (-2); + else if (result > 0) + { + if (FD_ISSET (selfds[0], &readfds)) + { + read (selfds[0], &c, 1); + if (c == 's') waiting = 1; + } + else + { + pthread_mutex_lock (&select_mutex); + if (select_valid & SELECT_HAVE_READ) + select_readfds = readfds; + if (select_valid & SELECT_HAVE_WRITE) + select_writefds = writefds; + if (select_valid & SELECT_HAVE_TMO) + select_timeout = timeout; + pthread_mutex_unlock (&select_mutex); + + ns_send_appdefined (result); + } + } + waiting = 1; + } } } @@ -5542,7 +5651,7 @@ - (BOOL)isOpaque if (ns_drag_types) [self registerForDraggedTypes: ns_drag_types]; - tem = FVAR (f, name); + tem = f->name; name = [NSString stringWithUTF8String: NILP (tem) ? "Emacs" : SSDATA (tem)]; [win setTitle: name]; @@ -5560,7 +5669,7 @@ - (BOOL)isOpaque #endif FRAME_TOOLBAR_HEIGHT (f) = 0; - tem = FVAR (f, icon_name); + tem = f->icon_name; if (!NILP (tem)) [win setMiniwindowTitle: [NSString stringWithUTF8String: SSDATA (tem)]]; @@ -5741,7 +5850,7 @@ - (void)mouseExited: (NSEvent *)theEvent { NSInteger tag = [sender tag]; find_and_call_menu_selection (emacsframe, emacsframe->menu_bar_items_used, - FVAR (emacsframe, menu_bar_vector), + emacsframe->menu_bar_vector, (void *)tag); } @@ -5775,8 +5884,8 @@ - (EmacsToolbar *)toolbar emacs_event->kind = TOOL_BAR_EVENT; /* XSETINT (emacs_event->code, 0); */ - emacs_event->arg = AREF (FVAR (emacsframe, tool_bar_items), - idx + TOOL_BAR_ITEM_KEY); + emacs_event->arg = AREF (emacsframe->tool_bar_items, + idx + TOOL_BAR_ITEM_KEY); emacs_event->modifiers = EV_MODIFIERS (theEvent); EV_TRAILER (theEvent); return self; @@ -6063,8 +6172,7 @@ - (id)accessibilityAttributeValue:(NSString *)attribute { Lisp_Object str = Qnil; struct frame *f = SELECTED_FRAME (); - struct buffer *curbuf - = XBUFFER (XWINDOW (FVAR (f, selected_window))->buffer); + struct buffer *curbuf = XBUFFER (XWINDOW (f->selected_window)->buffer); if ([attribute isEqualToString:NSAccessibilityRoleAttribute]) return NSAccessibilityTextFieldRole; @@ -6278,7 +6386,7 @@ - (void)dealloc { NSTRACE (EmacsScroller_dealloc); if (!NILP (win)) - XWINDOW (win)->vertical_scroll_bar = Qnil; + WSET (XWINDOW (win), vertical_scroll_bar, Qnil); [super dealloc]; } @@ -6401,8 +6509,13 @@ - (void) sendScrollEventAtLoc: (float)loc fromEvent: (NSEvent *)e XSETINT (emacs_event->x, loc * pixel_height); XSETINT (emacs_event->y, pixel_height-20); - n_emacs_events_pending++; - kbd_buffer_store_event_hold (emacs_event, q_event_ptr); + if (q_event_ptr) + { + n_emacs_events_pending++; + kbd_buffer_store_event_hold (emacs_event, q_event_ptr); + } + else + kbd_buffer_store_event (emacs_event); EVENT_INIT (*emacs_event); ns_send_appdefined (-1); } @@ -6709,7 +6822,6 @@ Convert an X font name (XLFD) to an NS font name. DEFSYM (Qmeta, "meta"); DEFSYM (Qsuper, "super"); DEFSYM (Qcontrol, "control"); - DEFSYM (Qnone, "none"); DEFSYM (QUTF8_STRING, "UTF8_STRING"); Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); diff --git a/src/print.c b/src/print.c index d0d2b00180b..1546ab3e229 100644 --- a/src/print.c +++ b/src/print.c @@ -394,16 +394,14 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) { /* Output to echo area. */ ptrdiff_t nbytes = SBYTES (string); - char *buffer; /* Copy the string contents so that relocation of STRING by GC does not cause trouble. */ USE_SAFE_ALLOCA; - - SAFE_ALLOCA (buffer, char *, nbytes); + char *buffer = SAFE_ALLOCA (nbytes); memcpy (buffer, SDATA (string), nbytes); - strout (buffer, chars, SBYTES (string), printcharfun); + strout (buffer, chars, nbytes, printcharfun); SAFE_FREE (); } @@ -498,14 +496,14 @@ temp_output_buffer_setup (const char *bufname) Fkill_all_local_variables (); delete_all_overlays (current_buffer); - BVAR (current_buffer, directory) = BVAR (old, directory); - BVAR (current_buffer, read_only) = Qnil; - BVAR (current_buffer, filename) = Qnil; - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, directory, BVAR (old, directory)); + BSET (current_buffer, read_only, Qnil); + BSET (current_buffer, filename, Qnil); + BSET (current_buffer, undo_list, Qt); eassert (current_buffer->overlays_before == NULL); eassert (current_buffer->overlays_after == NULL); - BVAR (current_buffer, enable_multibyte_characters) - = BVAR (&buffer_defaults, enable_multibyte_characters); + BSET (current_buffer, enable_multibyte_characters, + BVAR (&buffer_defaults, enable_multibyte_characters)); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -864,11 +862,11 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, if (!NILP (caller) && SYMBOLP (caller)) { Lisp_Object cname = SYMBOL_NAME (caller); - char *name; + ptrdiff_t cnamelen = SBYTES (cname); USE_SAFE_ALLOCA; - SAFE_ALLOCA (name, char *, SBYTES (cname)); - memcpy (name, SDATA (cname), SBYTES (cname)); - message_dolog (name, SBYTES (cname), 0, 0); + char *name = SAFE_ALLOCA (cnamelen); + memcpy (name, SDATA (cname), cnamelen); + message_dolog (name, cnamelen, 0, 0); message_dolog (": ", 2, 0, 0); SAFE_FREE (); } @@ -1198,7 +1196,7 @@ print_preprocess (Lisp_Object obj) { case Lisp_String: /* A string may have text properties, which can be circular. */ - traverse_intervals_noorder (STRING_INTERVALS (obj), + traverse_intervals_noorder (string_get_intervals (obj), print_preprocess_string, Qnil); break; @@ -1301,7 +1299,7 @@ static Lisp_Object print_prune_string_charset (Lisp_Object string) { print_check_string_result = 0; - traverse_intervals (STRING_INTERVALS (string), 0, + traverse_intervals (string_get_intervals (string), 0, print_check_string_charset_prop, string); if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { @@ -1412,7 +1410,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag if (! EQ (Vprint_charset_text_property, Qt)) obj = print_prune_string_charset (obj); - if (!NULL_INTERVAL_P (STRING_INTERVALS (obj))) + if (string_get_intervals (obj)) { PRINTCHAR ('#'); PRINTCHAR ('('); @@ -1503,9 +1501,9 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } PRINTCHAR ('\"'); - if (!NULL_INTERVAL_P (STRING_INTERVALS (obj))) + if (string_get_intervals (obj)) { - traverse_intervals (STRING_INTERVALS (obj), + traverse_intervals (string_get_intervals (obj), 0, print_interval, printcharfun); PRINTCHAR (')'); } @@ -1701,11 +1699,11 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag if (escapeflag) { strout ("#name, printcharfun); PRINTCHAR ('>'); } else - print_string (PVAR (XPROCESS (obj), name), printcharfun); + print_string (XPROCESS (obj)->name, printcharfun); } else if (BOOL_VECTOR_P (obj)) { @@ -1784,10 +1782,10 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag strout ("#sequence_number); strout (buf, len, len, printcharfun); - if (!NILP (WVAR (XWINDOW (obj), buffer))) + if (!NILP (XWINDOW (obj)->buffer)) { strout (" on ", -1, -1, printcharfun); - print_string (BVAR (XBUFFER (WVAR (XWINDOW (obj), buffer)), name), + print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); } PRINTCHAR ('>'); @@ -1907,7 +1905,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag else if (FRAMEP (obj)) { int len; - Lisp_Object frame_name = FVAR (XFRAME (obj), name); + Lisp_Object frame_name = XFRAME (obj)->name; strout ((FRAME_LIVE_P (XFRAME (obj)) ? "#type, Qnetwork)) +#define NETCONN1_P(p) (EQ (p->type, Qnetwork)) +#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial)) +#define SERIALCONN1_P(p) (EQ (p->type, Qserial)) #ifndef HAVE_H_ERRNO extern int h_errno; @@ -428,7 +428,7 @@ static void update_status (struct Lisp_Process *p) { eassert (p->raw_status_new); - PVAR (p, status) = status_convert (p->raw_status); + PSET (p, status, status_convert (p->raw_status)); p->raw_status_new = 0; } @@ -441,7 +441,7 @@ status_convert (int w) if (WIFSTOPPED (w)) return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil)); else if (WIFEXITED (w)) - return Fcons (Qexit, Fcons (make_number (WRETCODE (w)), + return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)), WCOREDUMP (w) ? Qt : Qnil)); else if (WIFSIGNALED (w)) return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)), @@ -479,7 +479,7 @@ decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, int *coredump) static Lisp_Object status_message (struct Lisp_Process *p) { - Lisp_Object status = PVAR (p, status); + Lisp_Object status = p->status; Lisp_Object symbol; int code, coredump; Lisp_Object string, string2; @@ -626,8 +626,8 @@ make_process (Lisp_Object name) p = allocate_process (); /* Initialize Lisp data. Note that allocate_process initializes all Lisp data to nil, so do it only for slots which should not be nil. */ - PVAR (p, status) = Qrun; - PVAR (p, mark) = Fmake_marker (); + PSET (p, status, Qrun); + PSET (p, mark, Fmake_marker ()); /* Initialize non-Lisp data. Note that allocate_process zeroes out all non-Lisp data, so do it only for slots which should not be zero. */ @@ -648,7 +648,7 @@ make_process (Lisp_Object name) name1 = concat2 (name, make_formatted_string (suffix, "<%"pMd">", i)); } name = name1; - PVAR (p, name) = name; + PSET (p, name, name); XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; @@ -745,7 +745,7 @@ nil, indicating the current buffer's process. */) p->raw_status_new = 0; if (NETCONN1_P (p) || SERIALCONN1_P (p)) { - PVAR (p, status) = Fcons (Qexit, Fcons (make_number (0), Qnil)); + PSET (p, status, Fcons (Qexit, Fcons (make_number (0), Qnil))); p->tick = ++process_tick; status_notify (p); redisplay_preserve_echo_area (13); @@ -763,9 +763,9 @@ nil, indicating the current buffer's process. */) /* If the process has already signaled, remove it from the list. */ if (p->raw_status_new) update_status (p); - symbol = PVAR (p, status); - if (CONSP (PVAR (p, status))) - symbol = XCAR (PVAR (p, status)); + symbol = p->status; + if (CONSP (p->status)) + symbol = XCAR (p->status); if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) deleted_pid_list = Fdelete (make_fixnum_or_float (pid), deleted_pid_list); @@ -774,8 +774,7 @@ nil, indicating the current buffer's process. */) { Fkill_process (process, Qnil); /* Do this now, since remove_process will make sigchld_handler do nothing. */ - PVAR (p, status) - = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); + PSET (p, status, Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil))); p->tick = ++process_tick; status_notify (p); redisplay_preserve_echo_area (13); @@ -816,14 +815,14 @@ nil, indicating the current buffer's process. */) p = XPROCESS (process); if (p->raw_status_new) update_status (p); - status = PVAR (p, status); + status = p->status; if (CONSP (status)) status = XCAR (status); if (NETCONN1_P (p) || SERIALCONN1_P (p)) { if (EQ (status, Qexit)) status = Qclosed; - else if (EQ (PVAR (p, command), Qt)) + else if (EQ (p->command, Qt)) status = Qstop; else if (EQ (status, Qrun)) status = Qopen; @@ -840,8 +839,8 @@ If PROCESS has not yet exited or died, return 0. */) CHECK_PROCESS (process); if (XPROCESS (process)->raw_status_new) update_status (XPROCESS (process)); - if (CONSP (PVAR (XPROCESS (process), status))) - return XCAR (XCDR (PVAR (XPROCESS (process), status))); + if (CONSP (XPROCESS (process)->status)) + return XCAR (XCDR (XPROCESS (process)->status)); return make_number (0); } @@ -865,7 +864,7 @@ possibly modified to make it unique among process names. */) (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), name); + return XPROCESS (process)->name; } DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, @@ -877,7 +876,7 @@ For a network or serial process, this is nil (process is running) or t (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), command); + return XPROCESS (process)->command; } DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, @@ -887,7 +886,7 @@ not the name of the pty that Emacs uses to talk with that terminal. */) (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), tty_name); + return XPROCESS (process)->tty_name; } DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, @@ -902,9 +901,9 @@ Return BUFFER. */) if (!NILP (buffer)) CHECK_BUFFER (buffer); p = XPROCESS (process); - PVAR (p, buffer) = buffer; + PSET (p, buffer, buffer); if (NETCONN1_P (p) || SERIALCONN1_P (p)) - PVAR (p, childp) = Fplist_put (PVAR (p, childp), QCbuffer, buffer); + PSET (p, childp, Fplist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); return buffer; } @@ -916,7 +915,7 @@ Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */) (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), buffer); + return XPROCESS (process)->buffer; } DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, @@ -925,7 +924,7 @@ DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), mark); + return XPROCESS (process)->mark; } DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, @@ -961,23 +960,23 @@ The string argument is normally a multibyte string, except: if (p->infd >= 0) { - if (EQ (filter, Qt) && !EQ (PVAR (p, status), Qlisten)) + if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) { FD_CLR (p->infd, &input_wait_mask); FD_CLR (p->infd, &non_keyboard_wait_mask); } - else if (EQ (PVAR (p, filter), Qt) + else if (EQ (p->filter, Qt) /* Network or serial process not stopped: */ - && !EQ (PVAR (p, command), Qt)) + && !EQ (p->command, Qt)) { FD_SET (p->infd, &input_wait_mask); FD_SET (p->infd, &non_keyboard_wait_mask); } } - PVAR (p, filter) = filter; + PSET (p, filter, filter); if (NETCONN1_P (p) || SERIALCONN1_P (p)) - PVAR (p, childp) = Fplist_put (PVAR (p, childp), QCfilter, filter); + PSET (p, childp, Fplist_put (p->childp, QCfilter, filter)); setup_process_coding_systems (process); return filter; } @@ -989,7 +988,7 @@ See `set-process-filter' for more info on filter functions. */) (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), filter); + return XPROCESS (process)->filter; } DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, @@ -1004,9 +1003,9 @@ It gets two arguments: the process, and a string describing the change. */) CHECK_PROCESS (process); p = XPROCESS (process); - PVAR (p, sentinel) = sentinel; + PSET (p, sentinel, sentinel); if (NETCONN1_P (p) || SERIALCONN1_P (p)) - PVAR (p, childp) = Fplist_put (PVAR (p, childp), QCsentinel, sentinel); + PSET (p, childp, Fplist_put (p->childp, QCsentinel, sentinel)); return sentinel; } @@ -1017,7 +1016,7 @@ See `set-process-sentinel' for more info on sentinels. */) (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), sentinel); + return XPROCESS (process)->sentinel; } DEFUN ("set-process-window-size", Fset_process_window_size, @@ -1102,7 +1101,7 @@ list of keywords. */) Lisp_Object contact; CHECK_PROCESS (process); - contact = PVAR (XPROCESS (process), childp); + contact = XPROCESS (process)->childp; #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CONN_P (process) @@ -1128,7 +1127,7 @@ DEFUN ("process-plist", Fprocess_plist, Sprocess_plist, (register Lisp_Object process) { CHECK_PROCESS (process); - return PVAR (XPROCESS (process), plist); + return XPROCESS (process)->plist; } DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist, @@ -1139,7 +1138,7 @@ DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist, CHECK_PROCESS (process); CHECK_LIST (plist); - PVAR (XPROCESS (process), plist) = plist; + PSET (XPROCESS (process), plist, plist); return plist; } @@ -1151,7 +1150,7 @@ The value is nil for a pipe, t or `pty' for a pty, or `stream' for a socket connection. */) (Lisp_Object process) { - return PVAR (XPROCESS (process), type); + return XPROCESS (process)->type; } #endif @@ -1164,7 +1163,7 @@ nil, indicating the current buffer's process. */) { Lisp_Object proc; proc = get_process (process); - return PVAR (XPROCESS (proc), type); + return XPROCESS (proc)->type; } DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address, @@ -1325,18 +1324,18 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) itself; it's all taken care of here. */ record_unwind_protect (start_process_unwind, proc); - PVAR (XPROCESS (proc), childp) = Qt; - PVAR (XPROCESS (proc), plist) = Qnil; - PVAR (XPROCESS (proc), type) = Qreal; - PVAR (XPROCESS (proc), buffer) = buffer; - PVAR (XPROCESS (proc), sentinel) = Qnil; - PVAR (XPROCESS (proc), filter) = Qnil; - PVAR (XPROCESS (proc), command) = Flist (nargs - 2, args + 2); + PSET (XPROCESS (proc), childp, Qt); + PSET (XPROCESS (proc), plist, Qnil); + PSET (XPROCESS (proc), type, Qreal); + PSET (XPROCESS (proc), buffer, buffer); + PSET (XPROCESS (proc), sentinel, Qnil); + PSET (XPROCESS (proc), filter, Qnil); + PSET (XPROCESS (proc), command, Flist (nargs - 2, args + 2)); #ifdef HAVE_GNUTLS /* AKA GNUTLS_INITSTAGE(proc). */ XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY; - XPROCESS (proc)->gnutls_cred_type = Qnil; + PSET (XPROCESS (proc), gnutls_cred_type, Qnil); #endif #ifdef ADAPTIVE_READ_BUFFERING @@ -1347,7 +1346,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) /* Make the process marker point into the process buffer (if any). */ if (BUFFERP (buffer)) - set_marker_both (PVAR (XPROCESS (proc), mark), buffer, + set_marker_both (XPROCESS (proc)->mark, buffer, BUF_ZV (XBUFFER (buffer)), BUF_ZV_BYTE (XBUFFER (buffer))); @@ -1376,7 +1375,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) else if (CONSP (Vdefault_process_coding_system)) val = XCAR (Vdefault_process_coding_system); } - PVAR (XPROCESS (proc), decode_coding_system) = val; + PSET (XPROCESS (proc), decode_coding_system, val); val = Vcoding_system_for_write; if (NILP (val)) @@ -1396,7 +1395,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) else if (CONSP (Vdefault_process_coding_system)) val = XCDR (Vdefault_process_coding_system); } - PVAR (XPROCESS (proc), encode_coding_system) = val; + PSET (XPROCESS (proc), encode_coding_system, val); /* Note: At this moment, the above coding system may leave text-conversion or eol-conversion unspecified. They will be decided after we read output from the process and decode it by @@ -1405,9 +1404,9 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) } - PVAR (XPROCESS (proc), decoding_buf) = empty_unibyte_string; + PSET (XPROCESS (proc), decoding_buf, empty_unibyte_string); XPROCESS (proc)->decoding_carryover = 0; - PVAR (XPROCESS (proc), encoding_buf) = empty_unibyte_string; + PSET (XPROCESS (proc), encoding_buf, empty_unibyte_string); XPROCESS (proc)->inherit_coding_system_flag = !(NILP (buffer) || !inherit_process_coding_system); @@ -1465,7 +1464,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) { if (NILP (arg_encoding)) arg_encoding = (complement_process_encoding_system - (PVAR (XPROCESS (proc), encode_coding_system))); + (XPROCESS (proc)->encode_coding_system)); XSETCAR (tem, code_convert_string_norecord (XCAR (tem), arg_encoding, 1)); @@ -1629,7 +1628,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) more portable (see USG_SUBTTY_WORKS above). */ XPROCESS (process)->pty_flag = pty_flag; - PVAR (XPROCESS (process), status) = Qrun; + PSET (XPROCESS (process), status, Qrun); /* Delay interrupts until we have a chance to store the new fork's pid in its process structure */ @@ -1868,10 +1867,10 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #ifdef HAVE_PTYS if (pty_flag) - PVAR (XPROCESS (process), tty_name) = build_string (pty_name); + PSET (XPROCESS (process), tty_name, build_string (pty_name)); else #endif - PVAR (XPROCESS (process), tty_name) = Qnil; + PSET (XPROCESS (process), tty_name, Qnil); #if !defined (WINDOWSNT) && defined (FD_CLOEXEC) /* Wait for child_setup to complete in case that vfork is @@ -1966,7 +1965,7 @@ create_pty (Lisp_Object process) more portable (see USG_SUBTTY_WORKS above). */ XPROCESS (process)->pty_flag = pty_flag; - PVAR (XPROCESS (process), status) = Qrun; + PSET (XPROCESS (process), status, Qrun); setup_process_coding_systems (process); FD_SET (inchannel, &input_wait_mask); @@ -1977,10 +1976,10 @@ create_pty (Lisp_Object process) XPROCESS (process)->pid = -2; #ifdef HAVE_PTYS if (pty_flag) - PVAR (XPROCESS (process), tty_name) = build_string (pty_name); + PSET (XPROCESS (process), tty_name, build_string (pty_name)); else #endif - PVAR (XPROCESS (process), tty_name) = Qnil; + PSET (XPROCESS (process), tty_name, Qnil); } @@ -2369,7 +2368,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */) if (set_socket_option (s, option, value)) { - PVAR (p, childp) = Fplist_put (PVAR (p, childp), option, value); + PSET (p, childp, Fplist_put (p->childp, option, value)); return Qt; } @@ -2458,10 +2457,10 @@ usage: (serial-process-configure &rest ARGS) */) proc = Fplist_get (contact, QCport); proc = get_process (proc); p = XPROCESS (proc); - if (!EQ (PVAR (p, type), Qserial)) + if (!EQ (p->type, Qserial)) error ("Not a serial process"); - if (NILP (Fplist_get (PVAR (p, childp), QCspeed))) + if (NILP (Fplist_get (p->childp, QCspeed))) { UNGCPRO; return Qnil; @@ -2602,21 +2601,21 @@ usage: (make-serial-process &rest ARGS) */) if (NILP (buffer)) buffer = name; buffer = Fget_buffer_create (buffer); - PVAR (p, buffer) = buffer; + PSET (p, buffer, buffer); - PVAR (p, childp) = contact; - PVAR (p, plist) = Fcopy_sequence (Fplist_get (contact, QCplist)); - PVAR (p, type) = Qserial; - PVAR (p, sentinel) = Fplist_get (contact, QCsentinel); - PVAR (p, filter) = Fplist_get (contact, QCfilter); - PVAR (p, log) = Qnil; + PSET (p, childp, contact); + PSET (p, plist, Fcopy_sequence (Fplist_get (contact, QCplist))); + PSET (p, type, Qserial); + PSET (p, sentinel, Fplist_get (contact, QCsentinel)); + PSET (p, filter, Fplist_get (contact, QCfilter)); + PSET (p, log, Qnil); if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) p->kill_without_query = 1; if (tem = Fplist_get (contact, QCstop), !NILP (tem)) - PVAR (p, command) = Qt; + PSET (p, command, Qt); p->pty_flag = 0; - if (!EQ (PVAR (p, command), Qt)) + if (!EQ (p->command, Qt)) { FD_SET (fd, &input_wait_mask); FD_SET (fd, &non_keyboard_wait_mask); @@ -2624,7 +2623,7 @@ usage: (make-serial-process &rest ARGS) */) if (BUFFERP (buffer)) { - set_marker_both (PVAR (p, mark), buffer, + set_marker_both (p->mark, buffer, BUF_ZV (XBUFFER (buffer)), BUF_ZV_BYTE (XBUFFER (buffer))); } @@ -2645,7 +2644,7 @@ usage: (make-serial-process &rest ARGS) */) else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; - PVAR (p, decode_coding_system) = val; + PSET (p, decode_coding_system, val); val = Qnil; if (!NILP (tem)) @@ -2659,12 +2658,12 @@ usage: (make-serial-process &rest ARGS) */) else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; - PVAR (p, encode_coding_system) = val; + PSET (p, encode_coding_system, val); setup_process_coding_systems (proc); - PVAR (p, decoding_buf) = empty_unibyte_string; + PSET (p, decoding_buf, empty_unibyte_string); p->decoding_carryover = 0; - PVAR (p, encoding_buf) = empty_unibyte_string; + PSET (p, encoding_buf, empty_unibyte_string); p->inherit_coding_system_flag = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); @@ -3401,27 +3400,27 @@ usage: (make-network-process &rest ARGS) */) p = XPROCESS (proc); - PVAR (p, childp) = contact; - PVAR (p, plist) = Fcopy_sequence (Fplist_get (contact, QCplist)); - PVAR (p, type) = Qnetwork; + PSET (p, childp, contact); + PSET (p, plist, Fcopy_sequence (Fplist_get (contact, QCplist))); + PSET (p, type, Qnetwork); - PVAR (p, buffer) = buffer; - PVAR (p, sentinel) = sentinel; - PVAR (p, filter) = filter; - PVAR (p, log) = Fplist_get (contact, QClog); + PSET (p, buffer, buffer); + PSET (p, sentinel, sentinel); + PSET (p, filter, filter); + PSET (p, log, Fplist_get (contact, QClog)); if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) p->kill_without_query = 1; if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) - PVAR (p, command) = Qt; + PSET (p, command, Qt); p->pid = 0; p->infd = inch; p->outfd = outch; if (is_server && socktype != SOCK_DGRAM) - PVAR (p, status) = Qlisten; + PSET (p, status, Qlisten); /* Make the process marker point into the process buffer (if any). */ if (BUFFERP (buffer)) - set_marker_both (PVAR (p, mark), buffer, + set_marker_both (p->mark, buffer, BUF_ZV (XBUFFER (buffer)), BUF_ZV_BYTE (XBUFFER (buffer))); @@ -3431,7 +3430,7 @@ usage: (make-network-process &rest ARGS) */) /* We may get here if connect did succeed immediately. However, in that case, we still need to signal this like a non-blocking connection. */ - PVAR (p, status) = Qconnect; + PSET (p, status, Qconnect); if (!FD_ISSET (inch, &connect_wait_mask)) { FD_SET (inch, &connect_wait_mask); @@ -3443,8 +3442,8 @@ usage: (make-network-process &rest ARGS) */) #endif /* A server may have a client filter setting of Qt, but it must still listen for incoming connects unless it is stopped. */ - if ((!EQ (PVAR (p, filter), Qt) && !EQ (PVAR (p, command), Qt)) - || (EQ (PVAR (p, status), Qlisten) && NILP (PVAR (p, command)))) + if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt)) + || (EQ (p->status, Qlisten) && NILP (p->command))) { FD_SET (inch, &input_wait_mask); FD_SET (inch, &non_keyboard_wait_mask); @@ -3498,7 +3497,7 @@ usage: (make-network-process &rest ARGS) */) else val = Qnil; } - PVAR (p, decode_coding_system) = val; + PSET (p, decode_coding_system, val); if (!NILP (tem)) { @@ -3532,13 +3531,13 @@ usage: (make-network-process &rest ARGS) */) else val = Qnil; } - PVAR (p, encode_coding_system) = val; + PSET (p, encode_coding_system, val); } setup_process_coding_systems (proc); - PVAR (p, decoding_buf) = empty_unibyte_string; + PSET (p, decoding_buf, empty_unibyte_string); p->decoding_carryover = 0; - PVAR (p, encoding_buf) = empty_unibyte_string; + PSET (p, encoding_buf, empty_unibyte_string); p->inherit_coding_system_flag = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); @@ -4031,8 +4030,8 @@ server_accept_connection (Lisp_Object server, int channel) return; #endif - if (!NILP (PVAR (ps, log))) - call3 (PVAR (ps, log), server, Qnil, + if (!NILP (ps->log)) + call3 (ps->log, server, Qnil, concat3 (build_string ("accept failed with code"), Fnumber_to_string (make_number (code)), build_string ("\n"))); @@ -4102,15 +4101,15 @@ server_accept_connection (Lisp_Object server, int channel) process name of the server process concatenated with the caller identification. */ - if (!NILP (PVAR (ps, filter)) && !EQ (PVAR (ps, filter), Qt)) + if (!NILP (ps->filter) && !EQ (ps->filter, Qt)) buffer = Qnil; else { - buffer = PVAR (ps, buffer); + buffer = ps->buffer; if (!NILP (buffer)) buffer = Fbuffer_name (buffer); else - buffer = PVAR (ps, name); + buffer = ps->name; if (!NILP (buffer)) { buffer = concat2 (buffer, caller); @@ -4121,7 +4120,7 @@ server_accept_connection (Lisp_Object server, int channel) /* Generate a unique name for the new server process. Combine the server process name with the caller identification. */ - name = concat2 (PVAR (ps, name), caller); + name = concat2 (ps->name, caller); proc = make_process (name); chan_process[s] = proc; @@ -4137,7 +4136,7 @@ server_accept_connection (Lisp_Object server, int channel) p = XPROCESS (proc); /* Build new contact information for this setup. */ - contact = Fcopy_sequence (PVAR (ps, childp)); + contact = Fcopy_sequence (ps->childp); contact = Fplist_put (contact, QCserver, Qnil); contact = Fplist_put (contact, QChost, host); if (!NILP (service)) @@ -4151,21 +4150,21 @@ server_accept_connection (Lisp_Object server, int channel) conv_sockaddr_to_lisp (&saddr.sa, len)); #endif - PVAR (p, childp) = contact; - PVAR (p, plist) = Fcopy_sequence (PVAR (ps, plist)); - PVAR (p, type) = Qnetwork; + PSET (p, childp, contact); + PSET (p, plist, Fcopy_sequence (ps->plist)); + PSET (p, type, Qnetwork); - PVAR (p, buffer) = buffer; - PVAR (p, sentinel) = PVAR (ps, sentinel); - PVAR (p, filter) = PVAR (ps, filter); - PVAR (p, command) = Qnil; + PSET (p, buffer, buffer); + PSET (p, sentinel, ps->sentinel); + PSET (p, filter, ps->filter); + PSET (p, command, Qnil); p->pid = 0; p->infd = s; p->outfd = s; - PVAR (p, status) = Qrun; + PSET (p, status, Qrun); /* Client processes for accepted connections are not stopped initially. */ - if (!EQ (PVAR (p, filter), Qt)) + if (!EQ (p->filter, Qt)) { FD_SET (s, &input_wait_mask); FD_SET (s, &non_keyboard_wait_mask); @@ -4179,24 +4178,24 @@ server_accept_connection (Lisp_Object server, int channel) of the new process should reflect the settings at the time the server socket was opened; not the current settings. */ - PVAR (p, decode_coding_system) = PVAR (ps, decode_coding_system); - PVAR (p, encode_coding_system) = PVAR (ps, encode_coding_system); + PSET (p, decode_coding_system, ps->decode_coding_system); + PSET (p, encode_coding_system, ps->encode_coding_system); setup_process_coding_systems (proc); - PVAR (p, decoding_buf) = empty_unibyte_string; + PSET (p, decoding_buf, empty_unibyte_string); p->decoding_carryover = 0; - PVAR (p, encoding_buf) = empty_unibyte_string; + PSET (p, encoding_buf, empty_unibyte_string); p->inherit_coding_system_flag = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag); - if (!NILP (PVAR (ps, log))) - call3 (PVAR (ps, log), server, proc, + if (!NILP (ps->log)) + call3 (ps->log, server, proc, concat3 (build_string ("accept from "), (STRINGP (host) ? host : build_string ("-")), build_string ("\n"))); - if (!NILP (PVAR (p, sentinel))) + if (!NILP (p->sentinel)) exec_sentinel (proc, concat3 (build_string ("open from "), (STRINGP (host) ? host : build_string ("-")), @@ -4287,8 +4286,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, FD_ZERO (&Writeok); if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit) - && !(CONSP (PVAR (wait_proc, status)) - && EQ (XCAR (PVAR (wait_proc, status)), Qexit))) + && !(CONSP (wait_proc->status) + && EQ (XCAR (wait_proc->status), Qexit))) message ("Blocking call to accept-process-output with quit inhibited!!"); /* If wait_proc is a process to watch, set wait_channel accordingly. */ @@ -4461,8 +4460,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (wait_proc && wait_proc->raw_status_new) update_status (wait_proc); if (wait_proc - && ! EQ (PVAR (wait_proc, status), Qrun) - && ! EQ (PVAR (wait_proc, status), Qconnect)) + && ! EQ (wait_proc->status, Qrun) + && ! EQ (wait_proc->status, Qconnect)) { int nread, total_nread = 0; @@ -4821,7 +4820,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, continue; /* If this is a server stream socket, accept connection. */ - if (EQ (PVAR (XPROCESS (proc), status), Qlisten)) + if (EQ (XPROCESS (proc)->status, Qlisten)) { server_accept_connection (proc, channel); continue; @@ -4887,10 +4886,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (p->pid == -2) { /* If the EIO occurs on a pty, sigchld_handler's - wait3() will not find the process object to + waitpid() will not find the process object to delete. Do it here. */ p->tick = ++process_tick; - PVAR (p, status) = Qfailed; + PSET (p, status, Qfailed); } else kill (getpid (), SIGCHLD); @@ -4909,9 +4908,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, deactivate_process (proc); if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); - if (EQ (PVAR (XPROCESS (proc), status), Qrun)) - PVAR (XPROCESS (proc), status) - = Fcons (Qexit, Fcons (make_number (256), Qnil)); + if (EQ (XPROCESS (proc)->status, Qrun)) + PSET (XPROCESS (proc), status, + Fcons (Qexit, Fcons (make_number (256), Qnil))); } } #ifdef NON_BLOCKING_CONNECT @@ -4959,18 +4958,18 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, if (xerrno) { p->tick = ++process_tick; - PVAR (p, status) - = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); + PSET (p, status, + Fcons (Qfailed, Fcons (make_number (xerrno), Qnil))); deactivate_process (proc); } else { - PVAR (p, status) = Qrun; + PSET (p, status, Qrun); /* Execute the sentinel here. If we had relied on status_notify to do it later, it will read input from the process before calling the sentinel. */ exec_sentinel (proc, build_string ("open\n")); - if (!EQ (PVAR (p, filter), Qt) && !EQ (PVAR (p, command), Qt)) + if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) { FD_SET (p->infd, &input_wait_mask); FD_SET (p->infd, &non_keyboard_wait_mask); @@ -5042,7 +5041,7 @@ read_process_output (Lisp_Object proc, register int channel) chars = alloca (carryover + readmax); if (carryover) /* See the comment above. */ - memcpy (chars, SDATA (PVAR (p, decoding_buf)), carryover); + memcpy (chars, SDATA (p->decoding_buf), carryover); #ifdef DATAGRAM_SOCKETS /* We have a working select, so proc_buffered_char is always -1. */ @@ -5121,7 +5120,7 @@ read_process_output (Lisp_Object proc, register int channel) record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); /* Read and dispose of the process output. */ - outstream = PVAR (p, filter); + outstream = p->filter; if (!NILP (outstream)) { Lisp_Object text; @@ -5163,9 +5162,9 @@ read_process_output (Lisp_Object proc, register int channel) text = coding->dst_object; Vlast_coding_system_used = CODING_ID_NAME (coding->id); /* A new coding system might be found. */ - if (!EQ (PVAR (p, decode_coding_system), Vlast_coding_system_used)) + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) { - PVAR (p, decode_coding_system) = Vlast_coding_system_used; + PSET (p, decode_coding_system, Vlast_coding_system_used); /* Don't call setup_coding_system for proc_decode_coding_system[channel] here. It is done in @@ -5178,21 +5177,21 @@ read_process_output (Lisp_Object proc, register int channel) proc_encode_coding_system[p->outfd] surely points to a valid memory because p->outfd will be changed once EOF is sent to the process. */ - if (NILP (PVAR (p, encode_coding_system)) + if (NILP (p->encode_coding_system) && proc_encode_coding_system[p->outfd]) { - PVAR (p, encode_coding_system) - = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); - setup_coding_system (PVAR (p, encode_coding_system), + PSET (p, encode_coding_system, + coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); + setup_coding_system (p->encode_coding_system, proc_encode_coding_system[p->outfd]); } } if (coding->carryover_bytes > 0) { - if (SCHARS (PVAR (p, decoding_buf)) < coding->carryover_bytes) - PVAR (p, decoding_buf) = make_uninit_string (coding->carryover_bytes); - memcpy (SDATA (PVAR (p, decoding_buf)), coding->carryover, + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + PSET (p, decoding_buf, make_uninit_string (coding->carryover_bytes)); + memcpy (SDATA (p->decoding_buf), coding->carryover, coding->carryover_bytes); p->decoding_carryover = coding->carryover_bytes; } @@ -5228,7 +5227,7 @@ read_process_output (Lisp_Object proc, register int channel) } /* If no filter, write into buffer if it isn't dead. */ - else if (!NILP (PVAR (p, buffer)) && !NILP (BVAR (XBUFFER (PVAR (p, buffer)), name))) + else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name))) { Lisp_Object old_read_only; ptrdiff_t old_begv, old_zv; @@ -5238,7 +5237,7 @@ read_process_output (Lisp_Object proc, register int channel) Lisp_Object text; struct buffer *b; - Fset_buffer (PVAR (p, buffer)); + Fset_buffer (p->buffer); opoint = PT; opoint_byte = PT_BYTE; old_read_only = BVAR (current_buffer, read_only); @@ -5247,16 +5246,16 @@ read_process_output (Lisp_Object proc, register int channel) old_begv_byte = BEGV_BYTE; old_zv_byte = ZV_BYTE; - BVAR (current_buffer, read_only) = Qnil; + BSET (current_buffer, read_only, Qnil); /* Insert new output into buffer at the current end-of-output marker, thus preserving logical ordering of input and output. */ - if (XMARKER (PVAR (p, mark))->buffer) + if (XMARKER (p->mark)->buffer) SET_PT_BOTH (clip_to_bounds (BEGV, - marker_position (PVAR (p, mark)), ZV), + marker_position (p->mark), ZV), clip_to_bounds (BEGV_BYTE, - marker_byte_position (PVAR (p, mark)), + marker_byte_position (p->mark), ZV_BYTE)); else SET_PT_BOTH (ZV, ZV_BYTE); @@ -5273,23 +5272,23 @@ read_process_output (Lisp_Object proc, register int channel) Vlast_coding_system_used = CODING_ID_NAME (coding->id); /* A new coding system might be found. See the comment in the similar code in the previous `if' block. */ - if (!EQ (PVAR (p, decode_coding_system), Vlast_coding_system_used)) + if (!EQ (p->decode_coding_system, Vlast_coding_system_used)) { - PVAR (p, decode_coding_system) = Vlast_coding_system_used; - if (NILP (PVAR (p, encode_coding_system)) + PSET (p, decode_coding_system, Vlast_coding_system_used); + if (NILP (p->encode_coding_system) && proc_encode_coding_system[p->outfd]) { - PVAR (p, encode_coding_system) - = coding_inherit_eol_type (Vlast_coding_system_used, Qnil); - setup_coding_system (PVAR (p, encode_coding_system), + PSET (p, encode_coding_system, + coding_inherit_eol_type (Vlast_coding_system_used, Qnil)); + setup_coding_system (p->encode_coding_system, proc_encode_coding_system[p->outfd]); } } if (coding->carryover_bytes > 0) { - if (SCHARS (PVAR (p, decoding_buf)) < coding->carryover_bytes) - PVAR (p, decoding_buf) = make_uninit_string (coding->carryover_bytes); - memcpy (SDATA (PVAR (p, decoding_buf)), coding->carryover, + if (SCHARS (p->decoding_buf) < coding->carryover_bytes) + PSET (p, decoding_buf, make_uninit_string (coding->carryover_bytes)); + memcpy (SDATA (p->decoding_buf), coding->carryover, coding->carryover_bytes); p->decoding_carryover = coding->carryover_bytes; } @@ -5307,11 +5306,11 @@ read_process_output (Lisp_Object proc, register int channel) /* Make sure the process marker's position is valid when the process buffer is changed in the signal_after_change above. W3 is known to do that. */ - if (BUFFERP (PVAR (p, buffer)) - && (b = XBUFFER (PVAR (p, buffer)), b != current_buffer)) - set_marker_both (PVAR (p, mark), PVAR (p, buffer), BUF_PT (b), BUF_PT_BYTE (b)); + if (BUFFERP (p->buffer) + && (b = XBUFFER (p->buffer), b != current_buffer)) + set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b)); else - set_marker_both (PVAR (p, mark), PVAR (p, buffer), PT, PT_BYTE); + set_marker_both (p->mark, p->buffer, PT, PT_BYTE); update_mode_lines++; @@ -5338,7 +5337,7 @@ read_process_output (Lisp_Object proc, register int channel) Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - BVAR (current_buffer, read_only) = old_read_only; + BSET (current_buffer, read_only, old_read_only); SET_PT_BOTH (opoint, opoint_byte); } /* Handling the process output should not deactivate the mark. */ @@ -5405,9 +5404,9 @@ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj, entry = Fcons (obj, Fcons (make_number (offset), make_number (len))); if (front) - PVAR (p, write_queue) = Fcons (entry, PVAR (p, write_queue)); + PSET (p, write_queue, Fcons (entry, p->write_queue)); else - PVAR (p, write_queue) = nconc2 (PVAR (p, write_queue), Fcons (entry, Qnil)); + PSET (p, write_queue, nconc2 (p->write_queue, Fcons (entry, Qnil))); } /* Remove the first element in the write_queue of process P, put its @@ -5421,11 +5420,11 @@ write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj, Lisp_Object entry, offset_length; ptrdiff_t offset; - if (NILP (PVAR (p, write_queue))) + if (NILP (p->write_queue)) return 0; - entry = XCAR (PVAR (p, write_queue)); - PVAR (p, write_queue) = XCDR (PVAR (p, write_queue)); + entry = XCAR (p->write_queue); + PSET (p, write_queue, XCDR (p->write_queue)); *obj = XCAR (entry); offset_length = XCDR (entry); @@ -5459,10 +5458,10 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, if (p->raw_status_new) update_status (p); - if (! EQ (PVAR (p, status), Qrun)) - error ("Process %s not running", SDATA (PVAR (p, name))); + if (! EQ (p->status, Qrun)) + error ("Process %s not running", SDATA (p->name)); if (p->outfd < 0) - error ("Output file descriptor of %s is closed", SDATA (PVAR (p, name))); + error ("Output file descriptor of %s is closed", SDATA (p->name)); coding = proc_encode_coding_system[p->outfd]; Vlast_coding_system_used = CODING_ID_NAME (coding->id); @@ -5472,9 +5471,9 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters))) || EQ (object, Qt)) { - PVAR (p, encode_coding_system) - = complement_process_encoding_system (PVAR (p, encode_coding_system)); - if (!EQ (Vlast_coding_system_used, PVAR (p, encode_coding_system))) + PSET (p, encode_coding_system, + complement_process_encoding_system (p->encode_coding_system)); + if (!EQ (Vlast_coding_system_used, p->encode_coding_system)) { /* The coding system for encoding was changed to raw-text because we sent a unibyte text previously. Now we are @@ -5484,8 +5483,8 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, Another reason we come here is that the coding system was just complemented and a new one was returned by complement_process_encoding_system. */ - setup_coding_system (PVAR (p, encode_coding_system), coding); - Vlast_coding_system_used = PVAR (p, encode_coding_system); + setup_coding_system (p->encode_coding_system, coding); + Vlast_coding_system_used = p->encode_coding_system; } coding->src_multibyte = 1; } @@ -5572,7 +5571,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, /* If there is already data in the write_queue, put the new data in the back of queue. Otherwise, ignore it. */ - if (!NILP (PVAR (p, write_queue))) + if (!NILP (p->write_queue)) write_queue_push (p, object, buf, len, 0); do /* while !NILP (p->write_queue) */ @@ -5686,7 +5685,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, cur_len -= written; } } - while (!NILP (PVAR (p, write_queue))); + while (!NILP (p->write_queue)); } else { @@ -5694,10 +5693,10 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, proc = process_sent_to; p = XPROCESS (proc); p->raw_status_new = 0; - PVAR (p, status) = Fcons (Qexit, Fcons (make_number (256), Qnil)); + PSET (p, status, Fcons (Qexit, Fcons (make_number (256), Qnil))); p->tick = ++process_tick; deactivate_process (proc); - error ("SIGPIPE raised on process %s; closed it", SDATA (PVAR (p, name))); + error ("SIGPIPE raised on process %s; closed it", SDATA (p->name)); } } @@ -5755,12 +5754,12 @@ emacs_get_tty_pgrp (struct Lisp_Process *p) pid_t gid = -1; #ifdef TIOCGPGRP - if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (PVAR (p, tty_name))) + if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) { int fd; /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the master side. Try the slave side. */ - fd = emacs_open (SSDATA (PVAR (p, tty_name)), O_RDONLY, 0); + fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0); if (fd != -1) { @@ -5789,12 +5788,12 @@ return t unconditionally. */) proc = get_process (process); p = XPROCESS (proc); - if (!EQ (PVAR (p, type), Qreal)) + if (!EQ (p->type, Qreal)) error ("Process %s is not a subprocess", - SDATA (PVAR (p, name))); + SDATA (p->name)); if (p->infd < 0) error ("Process %s is not active", - SDATA (PVAR (p, name))); + SDATA (p->name)); gid = emacs_get_tty_pgrp (p); @@ -5829,12 +5828,12 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, proc = get_process (process); p = XPROCESS (proc); - if (!EQ (PVAR (p, type), Qreal)) + if (!EQ (p->type, Qreal)) error ("Process %s is not a subprocess", - SDATA (PVAR (p, name))); + SDATA (p->name)); if (p->infd < 0) error ("Process %s is not active", - SDATA (PVAR (p, name))); + SDATA (p->name)); if (!p->pty_flag) current_group = Qnil; @@ -5923,7 +5922,7 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, #ifdef SIGCONT case SIGCONT: p->raw_status_new = 0; - PVAR (p, status) = Qrun; + PSET (p, status, Qrun); p->tick = ++process_tick; if (!nomsg) { @@ -6013,13 +6012,13 @@ traffic. */) struct Lisp_Process *p; p = XPROCESS (process); - if (NILP (PVAR (p, command)) + if (NILP (p->command) && p->infd >= 0) { FD_CLR (p->infd, &input_wait_mask); FD_CLR (p->infd, &non_keyboard_wait_mask); } - PVAR (p, command) = Qt; + PSET (p, command, Qt); return process; } #ifndef SIGTSTP @@ -6042,9 +6041,9 @@ traffic. */) struct Lisp_Process *p; p = XPROCESS (process); - if (EQ (PVAR (p, command), Qt) + if (EQ (p->command, Qt) && p->infd >= 0 - && (!EQ (PVAR (p, filter), Qt) || EQ (PVAR (p, status), Qlisten))) + && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) { FD_SET (p->infd, &input_wait_mask); FD_SET (p->infd, &non_keyboard_wait_mask); @@ -6055,7 +6054,7 @@ traffic. */) tcflush (p->infd, TCIFLUSH); #endif /* not WINDOWSNT */ } - PVAR (p, command) = Qnil; + PSET (p, command, Qnil); return process; } #ifdef SIGCONT @@ -6102,8 +6101,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) CHECK_PROCESS (process); pid = XPROCESS (process)->pid; if (pid <= 0) - error ("Cannot signal process %s", - SDATA (PVAR (XPROCESS (process), name))); + error ("Cannot signal process %s", SDATA (XPROCESS (process)->name)); } #define parse_signal(NAME, VALUE) \ @@ -6247,8 +6245,8 @@ process has been transmitted to the serial port. */) /* Make sure the process is really alive. */ if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); - if (! EQ (PVAR (XPROCESS (proc), status), Qrun)) - error ("Process %s not running", SDATA (PVAR (XPROCESS (proc), name))); + if (! EQ (XPROCESS (proc)->status, Qrun)) + error ("Process %s not running", SDATA (XPROCESS (proc)->name)); if (CODING_REQUIRE_FLUSHING (coding)) { @@ -6258,7 +6256,7 @@ process has been transmitted to the serial port. */) if (XPROCESS (proc)->pty_flag) send_process (proc, "\004", 1, Qnil); - else if (EQ (PVAR (XPROCESS (proc), type), Qserial)) + else if (EQ (XPROCESS (proc)->type, Qserial)) { #ifndef WINDOWSNT if (tcdrain (XPROCESS (proc)->outfd) != 0) @@ -6275,7 +6273,7 @@ process has been transmitted to the serial port. */) for communication with the subprocess, call shutdown to cause EOF. (In some old system, shutdown to socketpair doesn't work. Then we just can't win.) */ - if (EQ (PVAR (XPROCESS (proc), type), Qnetwork) + if (EQ (XPROCESS (proc)->type, Qnetwork) || XPROCESS (proc)->outfd == XPROCESS (proc)->infd) shutdown (XPROCESS (proc)->outfd, 1); /* In case of socketpair, outfd == infd, so don't close it. */ @@ -6352,7 +6350,7 @@ sigchld_handler (int signo) do { errno = 0; - pid = wait3 (&w, WNOHANG | WUNTRACED, 0); + pid = waitpid (-1, &w, WNOHANG | WUNTRACED); } while (pid < 0 && errno == EINTR); @@ -6388,7 +6386,7 @@ sigchld_handler (int signo) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (EQ (PVAR (p, type), Qreal) && p->pid == pid) + if (EQ (p->type, Qreal) && p->pid == pid) break; p = 0; } @@ -6440,7 +6438,7 @@ sigchld_handler (int signo) /* Report the status of the synchronous process. */ if (WIFEXITED (w)) - synch_process_retcode = WRETCODE (w); + synch_process_retcode = WEXITSTATUS (w); else if (WIFSIGNALED (w)) synch_process_termsig = WTERMSIG (w); @@ -6472,7 +6470,7 @@ sigchld_handler (int signo) static Lisp_Object exec_sentinel_unwind (Lisp_Object data) { - PVAR (XPROCESS (XCAR (data)), sentinel) = XCDR (data); + PSET (XPROCESS (XCAR (data)), sentinel, XCDR (data)); return Qnil; } @@ -6512,13 +6510,13 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) friends don't expect current-buffer to be changed from under them. */ record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); - sentinel = PVAR (p, sentinel); + sentinel = p->sentinel; if (NILP (sentinel)) return; /* Zilch the sentinel while it's running, to avoid recursive invocations; assure that it gets restored no matter how the sentinel exits. */ - PVAR (p, sentinel) = Qnil; + PSET (p, sentinel, Qnil); record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel)); /* Inhibit quit so that random quits don't screw up a running filter. */ specbind (Qinhibit_quit, Qt); @@ -6606,16 +6604,16 @@ status_notify (struct Lisp_Process *deleting_process) p->update_tick = p->tick; /* If process is still active, read any output that remains. */ - while (! EQ (PVAR (p, filter), Qt) - && ! EQ (PVAR (p, status), Qconnect) - && ! EQ (PVAR (p, status), Qlisten) + while (! EQ (p->filter, Qt) + && ! EQ (p->status, Qconnect) + && ! EQ (p->status, Qlisten) /* Network or serial process not stopped: */ - && ! EQ (PVAR (p, command), Qt) + && ! EQ (p->command, Qt) && p->infd >= 0 && p != deleting_process && read_process_output (proc, p->infd) > 0); - buffer = PVAR (p, buffer); + buffer = p->buffer; /* Get the text to use for the message. */ if (p->raw_status_new) @@ -6623,9 +6621,9 @@ status_notify (struct Lisp_Process *deleting_process) msg = status_message (p); /* If process is terminated, deactivate it or delete it. */ - symbol = PVAR (p, status); - if (CONSP (PVAR (p, status))) - symbol = XCAR (PVAR (p, status)); + symbol = p->status; + if (CONSP (p->status)) + symbol = XCAR (p->status); if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed)) @@ -6642,7 +6640,7 @@ status_notify (struct Lisp_Process *deleting_process) this code to be run again. */ p->update_tick = p->tick; /* Now output the message suitably. */ - if (!NILP (PVAR (p, sentinel))) + if (!NILP (p->sentinel)) exec_sentinel (proc, msg); /* Don't bother with a message in the buffer when a process becomes runnable. */ @@ -6664,8 +6662,8 @@ status_notify (struct Lisp_Process *deleting_process) /* Insert new output into buffer at the current end-of-output marker, thus preserving logical ordering of input and output. */ - if (XMARKER (PVAR (p, mark))->buffer) - Fgoto_char (PVAR (p, mark)); + if (XMARKER (p->mark)->buffer) + Fgoto_char (p->mark); else SET_PT_BOTH (ZV, ZV_BYTE); @@ -6673,13 +6671,14 @@ status_notify (struct Lisp_Process *deleting_process) before_byte = PT_BYTE; tem = BVAR (current_buffer, read_only); - BVAR (current_buffer, read_only) = Qnil; + BSET (current_buffer, read_only, Qnil); insert_string ("\nProcess "); - Finsert (1, &PVAR (p, name)); + { /* FIXME: temporary kludge */ + Lisp_Object tem2 = p->name; Finsert (1, &tem2); } insert_string (" "); Finsert (1, &msg); - BVAR (current_buffer, read_only) = tem; - set_marker_both (PVAR (p, mark), PVAR (p, buffer), PT, PT_BYTE); + BSET (current_buffer, read_only, tem); + set_marker_both (p->mark, p->buffer, PT, PT_BYTE); if (opoint >= before) SET_PT_BOTH (opoint + (PT - before), @@ -6709,14 +6708,14 @@ encode subprocess input. */) CHECK_PROCESS (process); p = XPROCESS (process); if (p->infd < 0) - error ("Input file descriptor of %s closed", SDATA (PVAR (p, name))); + error ("Input file descriptor of %s closed", SDATA (p->name)); if (p->outfd < 0) - error ("Output file descriptor of %s closed", SDATA (PVAR (p, name))); + error ("Output file descriptor of %s closed", SDATA (p->name)); Fcheck_coding_system (decoding); Fcheck_coding_system (encoding); encoding = coding_inherit_eol_type (encoding, Qnil); - PVAR (p, decode_coding_system) = decoding; - PVAR (p, encode_coding_system) = encoding; + PSET (p, decode_coding_system, decoding); + PSET (p, encode_coding_system, encoding); setup_process_coding_systems (process); return Qnil; @@ -6728,8 +6727,8 @@ DEFUN ("process-coding-system", (register Lisp_Object process) { CHECK_PROCESS (process); - return Fcons (PVAR (XPROCESS (process), decode_coding_system), - PVAR (XPROCESS (process), encode_coding_system)); + return Fcons (XPROCESS (process)->decode_coding_system, + XPROCESS (process)->encode_coding_system); } DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte, @@ -6746,8 +6745,8 @@ suppressed. */) CHECK_PROCESS (process); p = XPROCESS (process); if (NILP (flag)) - PVAR (p, decode_coding_system) - = raw_text_coding_system (PVAR (p, decode_coding_system)); + PSET (p, decode_coding_system, + raw_text_coding_system (p->decode_coding_system)); setup_process_coding_systems (process); return Qnil; @@ -7085,19 +7084,19 @@ setup_process_coding_systems (Lisp_Object process) if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system)); - coding_system = PVAR (p, decode_coding_system); - if (! NILP (PVAR (p, filter))) + coding_system = p->decode_coding_system; + if (! NILP (p->filter)) ; - else if (BUFFERP (PVAR (p, buffer))) + else if (BUFFERP (p->buffer)) { - if (NILP (BVAR (XBUFFER (PVAR (p, buffer)), enable_multibyte_characters))) + if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) coding_system = raw_text_coding_system (coding_system); } setup_coding_system (coding_system, proc_decode_coding_system[inch]); if (!proc_encode_coding_system[outch]) proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system)); - setup_coding_system (PVAR (p, encode_coding_system), + setup_coding_system (p->encode_coding_system, proc_encode_coding_system[outch]); #endif } @@ -7143,7 +7142,7 @@ BUFFER may be a buffer or the name of one. */) for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) { proc = Fcdr (XCAR (tail)); - if (PROCESSP (proc) && EQ (PVAR (XPROCESS (proc), buffer), buf)) + if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf)) return proc; } #endif /* subprocesses */ @@ -7182,7 +7181,7 @@ kill_buffer_processes (Lisp_Object buffer) { proc = XCDR (XCAR (tail)); if (PROCESSP (proc) - && (NILP (buffer) || EQ (PVAR (XPROCESS (proc), buffer), buffer))) + && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))) { if (NETCONN_P (proc) || SERIALCONN_P (proc)) Fdelete_process (proc); diff --git a/src/process.h b/src/process.h index dafa870b620..43cc7ea33c0 100644 --- a/src/process.h +++ b/src/process.h @@ -26,10 +26,10 @@ along with GNU Emacs. If not, see . */ #include "gnutls.h" #endif -/* Most code should use this macro to access +/* Most code should use these macros to set Lisp fields in struct Lisp_Process. */ -#define PVAR(w, field) ((w)->INTERNAL_FIELD (field)) +#define PSET(p, field, value) ((p)->field = (value)) /* This structure records information about a subprocess or network connection. */ @@ -39,65 +39,65 @@ struct Lisp_Process struct vectorlike_header header; /* Name of subprocess terminal. */ - Lisp_Object INTERNAL_FIELD (tty_name); + Lisp_Object tty_name; /* Name of this process */ - Lisp_Object INTERNAL_FIELD (name); + Lisp_Object name; /* List of command arguments that this process was run with. Is set to t for a stopped network process; nil otherwise. */ - Lisp_Object INTERNAL_FIELD (command); + Lisp_Object command; /* (funcall FILTER PROC STRING) (if FILTER is non-nil) to dispose of a bunch of chars from the process all at once */ - Lisp_Object INTERNAL_FIELD (filter); + Lisp_Object filter; /* (funcall SENTINEL PROCESS) when process state changes */ - Lisp_Object INTERNAL_FIELD (sentinel); + Lisp_Object sentinel; /* (funcall LOG SERVER CLIENT MESSAGE) when a server process accepts a connection from a client. */ - Lisp_Object INTERNAL_FIELD (log); + Lisp_Object log; /* Buffer that output is going to */ - Lisp_Object INTERNAL_FIELD (buffer); + Lisp_Object buffer; /* t if this is a real child process. For a network or serial connection, it is a plist based on the arguments to make-network-process or make-serial-process. */ - Lisp_Object INTERNAL_FIELD (childp); + Lisp_Object childp; /* Plist for programs to keep per-process state information, parameters, etc. */ - Lisp_Object INTERNAL_FIELD (plist); + Lisp_Object plist; /* Symbol indicating the type of process: real, network, serial */ - Lisp_Object INTERNAL_FIELD (type); + Lisp_Object type; /* Marker set to end of last buffer-inserted output from this process */ - Lisp_Object INTERNAL_FIELD (mark); + Lisp_Object mark; /* Symbol indicating status of process. This may be a symbol: run, open, or closed. Or it may be a list, whose car is stop, exit or signal and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG) or (SIGNAL_NUMBER . COREDUMP_FLAG). */ - Lisp_Object INTERNAL_FIELD (status); + Lisp_Object status; /* Coding-system for decoding the input from this process. */ - Lisp_Object INTERNAL_FIELD (decode_coding_system); + Lisp_Object decode_coding_system; /* Working buffer for decoding. */ - Lisp_Object INTERNAL_FIELD (decoding_buf); + Lisp_Object decoding_buf; /* Coding-system for encoding the output to this process. */ - Lisp_Object INTERNAL_FIELD (encode_coding_system); + Lisp_Object encode_coding_system; /* Working buffer for encoding. */ - Lisp_Object INTERNAL_FIELD (encoding_buf); + Lisp_Object encoding_buf; /* Queue for storing waiting writes */ - Lisp_Object INTERNAL_FIELD (write_queue); + Lisp_Object write_queue; #ifdef HAVE_GNUTLS Lisp_Object gnutls_cred_type; diff --git a/src/regex.c b/src/regex.c index afe3751ea5e..472ef727979 100644 --- a/src/regex.c +++ b/src/regex.c @@ -248,6 +248,7 @@ xrealloc (void *block, size_t size) # endif # define realloc xrealloc +# include # include /* Define the syntax stuff for \<, \>, etc. */ @@ -535,8 +536,6 @@ typedef const unsigned char re_char; #endif typedef char boolean; -#define false 0 -#define true 1 static regoff_t re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1, size_t size1, diff --git a/src/region-cache.c b/src/region-cache.c index 14b6233a5a5..d2bba8c11b2 100644 --- a/src/region-cache.c +++ b/src/region-cache.c @@ -245,16 +245,16 @@ move_cache_gap (struct region_cache *c, ptrdiff_t pos, ptrdiff_t min_size) when the portion after the gap is smallest. */ if (gap_len < min_size) { - ptrdiff_t i; + ptrdiff_t i, nboundaries = c->cache_len; c->boundaries = - xpalloc (c->boundaries, &c->cache_len, min_size, -1, + xpalloc (c->boundaries, &nboundaries, min_size - gap_len, -1, sizeof *c->boundaries); /* Some systems don't provide a version of the copy routine that can be trusted to shift memory upward into an overlapping region. memmove isn't widely available. */ - min_size -= gap_len; + min_size = nboundaries - c->cache_len - gap_len; for (i = c->cache_len - 1; i >= gap_start; i--) { c->boundaries[i + min_size].pos = c->boundaries[i + gap_len].pos; diff --git a/src/s/msdos.h b/src/s/msdos.h deleted file mode 100644 index 15112dad7a7..00000000000 --- a/src/s/msdos.h +++ /dev/null @@ -1,114 +0,0 @@ -/* System description file for MS-DOS - -Copyright (C) 1993, 1996-1997, 2001-2012 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* Note: lots of stuff here was taken from s-msdos.h in demacs. */ - - -/* Define symbols to identify the version of Unix this is. - Define all the symbols that apply correctly. */ -#ifndef MSDOS -#define MSDOS -#endif - -#ifndef __DJGPP__ -You lose; /* Emacs for DOS must be compiled with DJGPP */ -#endif - -#define DOS_NT /* MSDOS or WINDOWSNT */ - -/* subprocesses should be defined if you want to have code for - asynchronous subprocesses (as used in M-x compile and M-x shell). - This is the only system that needs this. */ -#undef subprocesses - -/* Here, on a separate page, add any special hacks needed to make - Emacs work on this system. For example, you might define certain - system call names that don't exist on your system, or that do - different things on your system and must be used only through an - encapsulation (which you should place, by convention, in sysdep.c). */ - -/* This overrides the default value on editfns.c, since DJGPP - does not have pw->pw_gecos. */ -#define USER_FULL_NAME (getenv ("NAME")) - -/* setjmp and longjmp can safely replace _setjmp and _longjmp, - but they will run slower. */ -#define _setjmp setjmp -#define _longjmp longjmp - -#define _NAIVE_DOS_REGS - -/* Used by emacs.c:decode_env_path. */ -#define SEPCHAR ';' - -/* Used by callproc.c (and process.c, but in the part not compiled on - MSDOS). The default is defined on process.h. */ -#define NULL_DEVICE "nul" - -/* Used by floatfns.c. */ -#define HAVE_INVERSE_HYPERBOLIC -#define FLOAT_CHECK_DOMAIN - -/* Start of gnulib-related stuff */ - -/* lib/ftoastr.c wants strtold, but DJGPP only has _strtold. DJGPP > - 2.03 has it, but it also has _strtold as a stub that jumps to - strtold, so use _strtold in all versions. */ -#define strtold _strtold - -#if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3 -# define HAVE_LSTAT 1 -#else -# define lstat stat -#endif - -/* End of gnulib-related stuff. */ - -/* When $TERM is "internal" then this is substituted: */ -#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display:\ -:co#80:li#25:Co#16:pa#256:km:ms:cm=:cl=:ce=:\ -:se=:so=:us=
    :ue=
:md=:mh=:mb=:mr=:me=:\ -:AB=:AF=:op=:" - -/* Define this to be the separator between devices and paths. Used by - lisp.h to define IS_DEVICE_SEP. */ -#define DEVICE_SEP ':' - -/* We'll support either convention of slashes on MSDOS. */ -#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\') -#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_)) - -/* Define one of these for easier conditionals. */ -#ifdef HAVE_X_WINDOWS -/* We need a little extra space, see ../../lisp/loadup.el and the - commentary below, in the non-X branch. The 140KB number was - measured on GNU/Linux and on MS-Windows. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+140000) -#else -/* We need a little extra space, see ../../lisp/loadup.el. - As of 20091024, DOS-specific files use up 62KB of pure space. But - overall, we end up wasting 130KB of pure space, because - BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including - non-DOS specific files and load history; the latter is about 55K, - but depends on the depth of the top-level Emacs directory in the - directory tree). Given the unknown policy of different DPMI - hosts regarding loading of untouched pages, I'm not going to risk - enlarging Emacs footprint by another 100+ KBytes. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+65000) -#endif diff --git a/src/search.c b/src/search.c index 480d0b75c70..004e599be9c 100644 --- a/src/search.c +++ b/src/search.c @@ -2226,6 +2226,9 @@ Otherwise treat `\\' as special: `\\N' means substitute what matched the Nth `\\(...\\)'. If Nth parens didn't match, substitute nothing. `\\\\' means insert one `\\'. + `\\?' is treated literally + (for compatibility with `query-replace-regexp'). + Any other character following `\\' signals an error. Case conversion does not apply to these substitutions. FIXEDCASE and LITERAL are optional arguments. @@ -2428,7 +2431,7 @@ since only regular expressions have distinguished subexpressions. */) } else if (c == '\\') delbackslash = 1; - else + else if (c != '?') error ("Invalid use of `\\' in replacement text"); } if (substart >= 0) diff --git a/src/stamp-h.in b/src/stamp-h.in deleted file mode 100644 index 9788f70238c..00000000000 --- a/src/stamp-h.in +++ /dev/null @@ -1 +0,0 @@ -timestamp diff --git a/src/syntax.c b/src/syntax.c index f0e30803dea..08a63e033b2 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -171,7 +171,7 @@ struct gl_state_s gl_state; /* Global state of syntax parser. */ direction than the intervals - or in an interval. We update the current syntax-table basing on the property of this interval, and update the interval to start further than CHARPOS - or be - NULL_INTERVAL. We also update lim_property to be the next value of + NULL. We also update lim_property to be the next value of charpos to call this subroutine again - or be before/after the start/end of OBJECT. */ @@ -192,7 +192,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init, i = interval_of (charpos, object); gl_state.backward_i = gl_state.forward_i = i; invalidate = 0; - if (NULL_INTERVAL_P (i)) + if (!i) return; /* interval_of updates only ->position of the return value, so update the parents manually to speed up update_interval. */ @@ -217,7 +217,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init, /* We are guaranteed to be called with CHARPOS either in i, or further off. */ - if (NULL_INTERVAL_P (i)) + if (!i) error ("Error in syntax_table logic for to-the-end intervals"); else if (charpos < i->position) /* Move left. */ { @@ -287,7 +287,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init, } } - while (!NULL_INTERVAL_P (i)) + while (i) { if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table))) { @@ -313,7 +313,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init, /* e_property at EOB is not set to ZV but to ZV+1, so that we can do INC(from);UPDATE_SYNTAX_TABLE_FORWARD without having to check eob between the two. */ - + (NULL_INTERVAL_P (next_interval (i)) ? 1 : 0); + + (next_interval (i) ? 0 : 1); gl_state.forward_i = i; } else @@ -326,7 +326,7 @@ update_syntax_table (ptrdiff_t charpos, EMACS_INT count, int init, cnt++; i = count > 0 ? next_interval (i) : previous_interval (i); } - eassert (NULL_INTERVAL_P (i)); /* This property goes to the end. */ + eassert (i == NULL); /* This property goes to the end. */ if (count > 0) gl_state.e_property = gl_state.stop; else @@ -836,7 +836,7 @@ One argument, a syntax table. */) { int idx; check_syntax_table (table); - BVAR (current_buffer, syntax_table) = table; + BSET (current_buffer, syntax_table, table); /* Indicate that this buffer now has a specified syntax table. */ idx = PER_BUFFER_VAR_IDX (syntax_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -1009,7 +1009,7 @@ The first character of NEWENTRY should be one of the following: " string quote. \\ escape. $ paired delimiter. ' expression quote or prefix operator. < comment starter. > comment ender. - / character-quote. @ inherit from `standard-syntax-table'. + / character-quote. @ inherit from parent table. | generic string fence. ! generic comment fence. Only single-character comment start and end sequences are represented thus. diff --git a/src/sysdep.c b/src/sysdep.c index 2bfdb35fdfb..01ca905a987 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -18,6 +18,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ #include + +#define SYSTIME_INLINE EXTERN_INLINE + #include #include #include @@ -294,7 +297,7 @@ wait_for_termination_1 (pid_t pid, int interruptible) #if (defined (BSD_SYSTEM) || defined (HPUX)) && !defined (__GNU__) /* Note that kill returns -1 even if the process is just a zombie now. But inevitably a SIGCHLD interrupt should be generated - and child_sig will do wait3 and make the process go away. */ + and child_sig will do waitpid and make the process go away. */ /* There is some indication that there is a bug involved with termination of subprocesses, perhaps involving a kernel bug too, but no idea what it is. Just as a hunch we signal SIGCHLD to see @@ -1968,7 +1971,7 @@ emacs_readlink (char const *filename, char initial_buf[READLINK_BUFSIZE]) * under error conditions. */ -#ifndef HAVE_GETWD +#if !defined (HAVE_GETWD) || defined (BROKEN_GETWD) #ifndef MAXPATHLEN /* In 4.1, param.h fails to define this. */ @@ -1998,7 +2001,7 @@ getwd (char *pathname) return pathname; } -#endif /* HAVE_GETWD */ +#endif /* !defined (HAVE_GETWD) || defined (BROKEN_GETWD) */ /* * This function will go away as soon as all the stubs fixed. (fnf) @@ -2028,7 +2031,7 @@ closedir (DIR *dirp /* stream from opendir */) int rtnval; rtnval = emacs_close (dirp->dd_fd); - xfree ((char *) dirp); + xfree (dirp); return rtnval; } @@ -2156,7 +2159,7 @@ serial_configure (struct Lisp_Process *p, int err = -1; char summary[4] = "???"; /* This usually becomes "8N1". */ - childp2 = Fcopy_sequence (PVAR (p, childp)); + childp2 = Fcopy_sequence (p->childp); /* Read port attributes and prepare default configuration. */ err = tcgetattr (p->outfd, &attr); @@ -2174,7 +2177,7 @@ serial_configure (struct Lisp_Process *p, if (!NILP (Fplist_member (contact, QCspeed))) tem = Fplist_get (contact, QCspeed); else - tem = Fplist_get (PVAR (p, childp), QCspeed); + tem = Fplist_get (p->childp, QCspeed); CHECK_NUMBER (tem); err = cfsetspeed (&attr, XINT (tem)); if (err != 0) @@ -2186,7 +2189,7 @@ serial_configure (struct Lisp_Process *p, if (!NILP (Fplist_member (contact, QCbytesize))) tem = Fplist_get (contact, QCbytesize); else - tem = Fplist_get (PVAR (p, childp), QCbytesize); + tem = Fplist_get (p->childp, QCbytesize); if (NILP (tem)) tem = make_number (8); CHECK_NUMBER (tem); @@ -2207,7 +2210,7 @@ serial_configure (struct Lisp_Process *p, if (!NILP (Fplist_member (contact, QCparity))) tem = Fplist_get (contact, QCparity); else - tem = Fplist_get (PVAR (p, childp), QCparity); + tem = Fplist_get (p->childp, QCparity); if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd)) error (":parity must be nil (no parity), `even', or `odd'"); #if defined (PARENB) && defined (PARODD) && defined (IGNPAR) && defined (INPCK) @@ -2240,7 +2243,7 @@ serial_configure (struct Lisp_Process *p, if (!NILP (Fplist_member (contact, QCstopbits))) tem = Fplist_get (contact, QCstopbits); else - tem = Fplist_get (PVAR (p, childp), QCstopbits); + tem = Fplist_get (p->childp, QCstopbits); if (NILP (tem)) tem = make_number (1); CHECK_NUMBER (tem); @@ -2262,7 +2265,7 @@ serial_configure (struct Lisp_Process *p, if (!NILP (Fplist_member (contact, QCflowcontrol))) tem = Fplist_get (contact, QCflowcontrol); else - tem = Fplist_get (PVAR (p, childp), QCflowcontrol); + tem = Fplist_get (p->childp, QCflowcontrol); if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw)) error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'"); #if defined (CRTSCTS) @@ -2304,7 +2307,7 @@ serial_configure (struct Lisp_Process *p, error ("tcsetattr() failed: %s", emacs_strerror (errno)); childp2 = Fplist_put (childp2, QCsummary, build_string (summary)); - PVAR (p, childp) = childp2; + PSET (p, childp, childp2); } #endif /* not DOS_NT */ diff --git a/src/systime.h b/src/systime.h index 29886248527..d3bdeb83019 100644 --- a/src/systime.h +++ b/src/systime.h @@ -21,6 +21,11 @@ along with GNU Emacs. If not, see . */ #include +INLINE_HEADER_BEGIN +#ifndef SYSTIME_INLINE +# define SYSTIME_INLINE INLINE +#endif + #ifdef emacs # ifdef HAVE_X_WINDOWS # include @@ -54,12 +59,12 @@ enum { LOG10_EMACS_TIME_RESOLUTION = 9 }; /* EMACS_SECS (TIME) is the seconds component of TIME. EMACS_NSECS (TIME) is the nanoseconds component of TIME. emacs_secs_addr (PTIME) is the address of *PTIME's seconds component. */ -static inline time_t EMACS_SECS (EMACS_TIME t) { return t.tv_sec; } -static inline int EMACS_NSECS (EMACS_TIME t) { return t.tv_nsec; } -static inline time_t *emacs_secs_addr (EMACS_TIME *t) { return &t->tv_sec; } +SYSTIME_INLINE time_t EMACS_SECS (EMACS_TIME t) { return t.tv_sec; } +SYSTIME_INLINE int EMACS_NSECS (EMACS_TIME t) { return t.tv_nsec; } +SYSTIME_INLINE time_t *emacs_secs_addr (EMACS_TIME *t) { return &t->tv_sec; } /* Return an Emacs time with seconds S and nanoseconds NS. */ -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME make_emacs_time (time_t s, int ns) { EMACS_TIME r = { s, ns }; @@ -67,7 +72,7 @@ make_emacs_time (time_t s, int ns) } /* Return an invalid Emacs time. */ -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME invalid_emacs_time (void) { EMACS_TIME r = { 0, -1 }; @@ -75,7 +80,7 @@ invalid_emacs_time (void) } /* Return current system time. */ -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME current_emacs_time (void) { EMACS_TIME r; @@ -92,12 +97,12 @@ current_emacs_time (void) be used with their first argument an absolute time since the epoch and the second argument a non-negative offset. Do NOT use them for anything else. */ -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME add_emacs_time (EMACS_TIME a, EMACS_TIME b) { return timespec_add (a, b); } -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME sub_emacs_time (EMACS_TIME a, EMACS_TIME b) { return timespec_sub (a, b); @@ -106,14 +111,14 @@ sub_emacs_time (EMACS_TIME a, EMACS_TIME b) /* Return the sign of the valid time stamp TIME, either -1, 0, or 1. Note: this can only return a negative value if time_t is a signed data type. */ -static inline int +SYSTIME_INLINE int EMACS_TIME_SIGN (EMACS_TIME t) { return timespec_sign (t); } /* Return 1 if TIME is a valid time stamp. */ -static inline int +SYSTIME_INLINE int EMACS_TIME_VALID_P (EMACS_TIME t) { return 0 <= t.tv_nsec; @@ -123,14 +128,14 @@ EMACS_TIME_VALID_P (EMACS_TIME t) On overflow, return an extremal value; in particular, if time_t is an unsigned data type and D is negative, return zero. Return the minimum EMACS_TIME if D is not a number. */ -static inline EMACS_TIME +SYSTIME_INLINE EMACS_TIME EMACS_TIME_FROM_DOUBLE (double d) { return dtotimespec (d); } /* Convert the Emacs time T to an approximate double value D. */ -static inline double +SYSTIME_INLINE double EMACS_TIME_TO_DOUBLE (EMACS_TIME t) { return timespectod (t); @@ -155,35 +160,37 @@ extern EMACS_TIME lisp_time_argument (Lisp_Object); #endif /* Compare times T1 and T2 for equality, inequality etc. */ -static inline int +SYSTIME_INLINE int EMACS_TIME_EQ (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) == 0; } -static inline int +SYSTIME_INLINE int EMACS_TIME_NE (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) != 0; } -static inline int +SYSTIME_INLINE int EMACS_TIME_GT (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) > 0; } -static inline int +SYSTIME_INLINE int EMACS_TIME_GE (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) >= 0; } -static inline int +SYSTIME_INLINE int EMACS_TIME_LT (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) < 0; } -static inline int +SYSTIME_INLINE int EMACS_TIME_LE (EMACS_TIME t1, EMACS_TIME t2) { return timespec_cmp (t1, t2) <= 0; } +INLINE_HEADER_END + #endif /* EMACS_SYSTIME_H */ diff --git a/src/systty.h b/src/systty.h index a258635ac09..ae98f123f2a 100644 --- a/src/systty.h +++ b/src/systty.h @@ -41,7 +41,7 @@ along with GNU Emacs. If not, see . */ /* Special cases - inhibiting the use of certain features. */ -/* Allow m- file to inhibit use of FIONREAD. */ +/* Allow configure to inhibit use of FIONREAD. */ #ifdef BROKEN_FIONREAD #undef FIONREAD #undef ASYNC diff --git a/src/syswait.h b/src/syswait.h index aea9ea6e588..9d84876d4be 100644 --- a/src/syswait.h +++ b/src/syswait.h @@ -51,9 +51,4 @@ along with GNU Emacs. If not, see . */ #define WTERMSIG(status) ((status) & 0x7f) #endif -#undef WRETCODE -#define WRETCODE(status) WEXITSTATUS (status) - - #endif /* EMACS_SYSWAIT_H */ - diff --git a/src/term.c b/src/term.c index 803bb6458b6..514c7ad11ec 100644 --- a/src/term.c +++ b/src/term.c @@ -1333,7 +1333,7 @@ term_get_fkeys_1 (void) /* This can happen if CANNOT_DUMP or with strange options. */ if (!KEYMAPP (KVAR (kboard, Vinput_decode_map))) - KVAR (kboard, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); + KSET (kboard, Vinput_decode_map, Fmake_sparse_keymap (Qnil)); for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) { @@ -2192,7 +2192,7 @@ set_tty_color_mode (struct tty_display_info *tty, struct frame *f) Lisp_Object tty_color_mode_alist = Fintern_soft (build_string ("tty-color-mode-alist"), Qnil); - tem = assq_no_quit (Qtty_color_mode, FVAR (f, param_alist)); + tem = assq_no_quit (Qtty_color_mode, f->param_alist); val = CONSP (tem) ? XCDR (tem) : Qnil; if (INTEGERP (val)) @@ -3281,7 +3281,7 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ terminal->kboard = xmalloc (sizeof *terminal->kboard); init_kboard (terminal->kboard); - KVAR (terminal->kboard, Vwindow_system) = Qnil; + KSET (terminal->kboard, Vwindow_system, Qnil); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; terminal->kboard->reference_count++; @@ -3571,14 +3571,14 @@ This variable can be used by terminal emulator packages. */); #endif DEFVAR_LISP ("suspend-tty-functions", Vsuspend_tty_functions, - doc: /* Functions to be run after suspending a tty. + doc: /* Functions run after suspending a tty. The functions are run with one argument, the terminal object to be suspended. See `suspend-tty'. */); Vsuspend_tty_functions = Qnil; DEFVAR_LISP ("resume-tty-functions", Vresume_tty_functions, - doc: /* Functions to be run after resuming a tty. + doc: /* Functions run after resuming a tty. The functions are run with one argument, the terminal object that was revived. See `resume-tty'. */); Vresume_tty_functions = Qnil; diff --git a/src/termhooks.h b/src/termhooks.h index 5df11557844..51815886c78 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -324,6 +324,10 @@ struct ns_display_info; struct x_display_info; struct w32_display_info; +/* Most code should use this macro to set Lisp field in struct terminal. */ + +#define TSET(f, field, value) ((f)->field = (value)) + /* Terminal-local parameters. */ struct terminal { diff --git a/src/terminal.c b/src/terminal.c index 4e03c162213..53610d9736f 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -446,7 +446,7 @@ store_terminal_param (struct terminal *t, Lisp_Object parameter, Lisp_Object val Lisp_Object old_alist_elt = Fassq (parameter, t->param_alist); if (EQ (old_alist_elt, Qnil)) { - t->param_alist = Fcons (Fcons (parameter, value), t->param_alist); + TSET (t, param_alist, Fcons (Fcons (parameter, value), t->param_alist)); return Qnil; } else diff --git a/src/textprop.c b/src/textprop.c index ee5d82fa170..ac1980fde78 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -105,7 +105,7 @@ text_read_only (Lisp_Object propval) Fprevious_property_change which call this function with BEGIN == END. Handle this case specially. - If FORCE is soft (0), it's OK to return NULL_INTERVAL. Otherwise, + If FORCE is soft (0), it's OK to return NULL. Otherwise, create an interval tree for OBJECT if one doesn't exist, provided the object actually contains text. In the current design, if there is no text, there can be no text properties. */ @@ -126,7 +126,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en /* If we are asked for a point, but from a subr which operates on a range, then return nothing. */ if (EQ (*begin, *end) && begin != end) - return NULL_INTERVAL; + return NULL; if (XINT (*begin) > XINT (*end)) { @@ -143,11 +143,11 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en if (!(BUF_BEGV (b) <= XINT (*begin) && XINT (*begin) <= XINT (*end) && XINT (*end) <= BUF_ZV (b))) args_out_of_range (*begin, *end); - i = BUF_INTERVALS (b); + i = buffer_get_intervals (b); /* If there's no text, there are no properties. */ if (BUF_BEGV (b) == BUF_ZV (b)) - return NULL_INTERVAL; + return NULL; searchpos = XINT (*begin); } @@ -161,15 +161,15 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *en XSETFASTINT (*begin, XFASTINT (*begin)); if (begin != end) XSETFASTINT (*end, XFASTINT (*end)); - i = STRING_INTERVALS (object); + i = string_get_intervals (object); if (len == 0) - return NULL_INTERVAL; + return NULL; searchpos = XINT (*begin); } - if (NULL_INTERVAL_P (i)) + if (!i) return (force ? create_root_interval (object) : i); return find_interval (i, searchpos); @@ -338,7 +338,7 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object) } /* Store new properties. */ - interval->plist = Fcopy_sequence (properties); + interval_set_plist (interval, Fcopy_sequence (properties)); } /* Add the properties of PLIST to the interval I, or set @@ -411,7 +411,7 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object) record_property_change (i->position, LENGTH (i), sym1, Qnil, object); } - i->plist = Fcons (sym1, Fcons (val1, i->plist)); + interval_set_plist (i, Fcons (sym1, Fcons (val1, i->plist))); changed++; } } @@ -484,7 +484,7 @@ remove_properties (Lisp_Object plist, Lisp_Object list, INTERVAL i, Lisp_Object } if (changed) - i->plist = current_plist; + interval_set_plist (i, current_plist); return changed; } @@ -500,7 +500,7 @@ interval_of (ptrdiff_t position, Lisp_Object object) if (NILP (object)) XSETBUFFER (object, current_buffer); else if (EQ (object, Qt)) - return NULL_INTERVAL; + return NULL; CHECK_STRING_OR_BUFFER (object); @@ -510,19 +510,19 @@ interval_of (ptrdiff_t position, Lisp_Object object) beg = BUF_BEGV (b); end = BUF_ZV (b); - i = BUF_INTERVALS (b); + i = buffer_get_intervals (b); } else { beg = 0; end = SCHARS (object); - i = STRING_INTERVALS (object); + i = string_get_intervals (object); } if (!(beg <= position && position <= end)) args_out_of_range (make_number (position), make_number (position)); - if (beg == end || NULL_INTERVAL_P (i)) - return NULL_INTERVAL; + if (beg == end || !i) + return NULL; return find_interval (i, position); } @@ -542,7 +542,7 @@ If POSITION is at the end of OBJECT, the value is nil. */) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &position, &position, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; /* If POSITION is at the end of the interval, it means it's the end of OBJECT. @@ -587,7 +587,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop, if (WINDOWP (object)) { w = XWINDOW (object); - object = WVAR (w, buffer); + object = w->buffer; } if (BUFFERP (object)) { @@ -922,12 +922,12 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) bother checking further intervals. */ if (EQ (limit, Qt)) { - if (NULL_INTERVAL_P (i)) + if (!i) next = i; else next = next_interval (i); - if (NULL_INTERVAL_P (next)) + if (!next) XSETFASTINT (position, (STRINGP (object) ? SCHARS (object) : BUF_ZV (XBUFFER (object)))); @@ -936,16 +936,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) return position; } - if (NULL_INTERVAL_P (i)) + if (!i) return limit; next = next_interval (i); - while (!NULL_INTERVAL_P (next) && intervals_equal (i, next) + while (next && intervals_equal (i, next) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); - if (NULL_INTERVAL_P (next) + if (!next || (next->position >= (INTEGERP (limit) ? XFASTINT (limit) @@ -983,17 +983,17 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) CHECK_NUMBER_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return limit; here_val = textget (i->plist, prop); next = next_interval (i); - while (! NULL_INTERVAL_P (next) + while (next && EQ (here_val, textget (next->plist, prop)) && (NILP (limit) || next->position < XFASTINT (limit))) next = next_interval (next); - if (NULL_INTERVAL_P (next) + if (!next || (next->position >= (INTEGERP (limit) ? XFASTINT (limit) @@ -1029,7 +1029,7 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) CHECK_NUMBER_COERCE_MARKER (limit); i = validate_interval_range (object, &position, &position, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return limit; /* Start with the interval containing the char before point. */ @@ -1037,12 +1037,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) i = previous_interval (i); previous = previous_interval (i); - while (!NULL_INTERVAL_P (previous) && intervals_equal (previous, i) + while (previous && intervals_equal (previous, i) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); - if (NULL_INTERVAL_P (previous) + if (!previous || (previous->position + LENGTH (previous) <= (INTEGERP (limit) ? XFASTINT (limit) @@ -1080,21 +1080,21 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) i = validate_interval_range (object, &position, &position, soft); /* Start with the interval containing the char before point. */ - if (!NULL_INTERVAL_P (i) && i->position == XFASTINT (position)) + if (i && i->position == XFASTINT (position)) i = previous_interval (i); - if (NULL_INTERVAL_P (i)) + if (!i) return limit; here_val = textget (i->plist, prop); previous = previous_interval (i); - while (!NULL_INTERVAL_P (previous) + while (previous && EQ (here_val, textget (previous->plist, prop)) && (NILP (limit) || (previous->position + LENGTH (previous) > XFASTINT (limit)))) previous = previous_interval (previous); - if (NULL_INTERVAL_P (previous) + if (!previous || (previous->position + LENGTH (previous) <= (INTEGERP (limit) ? XFASTINT (limit) @@ -1130,7 +1130,7 @@ Return t if any property value actually changed, nil otherwise. */) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, hard); - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; s = XINT (start); @@ -1274,16 +1274,16 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, && XFASTINT (start) == 0 && XFASTINT (end) == SCHARS (object)) { - if (! STRING_INTERVALS (object)) + if (!string_get_intervals (object)) return Qnil; - STRING_SET_INTERVALS (object, NULL_INTERVAL); + string_set_intervals (object, NULL); return Qt; } i = validate_interval_range (object, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) { /* If buffer has no properties, and we want none, return now. */ if (NILP (properties)) @@ -1296,7 +1296,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, i = validate_interval_range (object, &start, &end, hard); /* This can return if start == end. */ - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; } @@ -1321,7 +1321,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, void set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i) { - register INTERVAL prev_changed = NULL_INTERVAL; + register INTERVAL prev_changed = NULL; register ptrdiff_t s, len; INTERVAL unchanged; @@ -1338,8 +1338,8 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie else return; - if (i == 0) - i = find_interval (BUF_INTERVALS (XBUFFER (buffer)), s); + if (i == NULL) + i = find_interval (buffer_get_intervals (XBUFFER (buffer)), s); if (i->position != s) { @@ -1378,7 +1378,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie merge the intervals, so as to make the undo records and cause redisplay to happen. */ set_properties (properties, i, buffer); - if (!NULL_INTERVAL_P (prev_changed)) + if (prev_changed) merge_interval_left (i); return; } @@ -1389,7 +1389,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object propertie merge the intervals, so as to make the undo records and cause redisplay to happen. */ set_properties (properties, i, buffer); - if (NULL_INTERVAL_P (prev_changed)) + if (!prev_changed) prev_changed = i; else prev_changed = i = merge_interval_left (i); @@ -1421,7 +1421,7 @@ Use `set-text-properties' if you want to remove all text properties. */) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; s = XINT (start); @@ -1508,7 +1508,7 @@ Return t if any property was actually removed, nil otherwise. */) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; s = XINT (start); @@ -1613,11 +1613,11 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return (!NILP (value) || EQ (start, end) ? Qnil : start); e = XINT (end); - while (! NULL_INTERVAL_P (i)) + while (i) { if (i->position >= e) break; @@ -1649,12 +1649,12 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ if (NILP (object)) XSETBUFFER (object, current_buffer); i = validate_interval_range (object, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return (NILP (value) || EQ (start, end)) ? Qnil : start; s = XINT (start); e = XINT (end); - while (! NULL_INTERVAL_P (i)) + while (i) { if (i->position >= e) break; @@ -1759,7 +1759,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ struct gcpro gcpro1, gcpro2; i = validate_interval_range (src, &start, &end, soft); - if (NULL_INTERVAL_P (i)) + if (!i) return Qnil; CHECK_NUMBER_COERCE_MARKER (pos); @@ -1811,7 +1811,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ } i = next_interval (i); - if (NULL_INTERVAL_P (i)) + if (!i) break; p += len; @@ -1852,7 +1852,7 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp result = Qnil; i = validate_interval_range (object, &start, &end, soft); - if (!NULL_INTERVAL_P (i)) + if (i) { ptrdiff_t s = XINT (start); ptrdiff_t e = XINT (end); @@ -1884,7 +1884,7 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp result); i = next_interval (i); - if (NULL_INTERVAL_P (i)) + if (!i) break; s = i->position; } @@ -1993,7 +1993,7 @@ void verify_interval_modification (struct buffer *buf, ptrdiff_t start, ptrdiff_t end) { - register INTERVAL intervals = BUF_INTERVALS (buf); + register INTERVAL intervals = buffer_get_intervals (buf); register INTERVAL i; Lisp_Object hooks; register Lisp_Object prev_mod_hooks; @@ -2007,7 +2007,7 @@ verify_interval_modification (struct buffer *buf, interval_insert_behind_hooks = Qnil; interval_insert_in_front_hooks = Qnil; - if (NULL_INTERVAL_P (intervals)) + if (!intervals) return; if (start > end) @@ -2048,7 +2048,7 @@ verify_interval_modification (struct buffer *buf, indirectly defined via the category property. */ if (i != prev) { - if (! NULL_INTERVAL_P (i)) + if (i) { after = textget (i->plist, Qread_only); @@ -2068,7 +2068,7 @@ verify_interval_modification (struct buffer *buf, } } - if (! NULL_INTERVAL_P (prev)) + if (prev) { before = textget (prev->plist, Qread_only); @@ -2088,7 +2088,7 @@ verify_interval_modification (struct buffer *buf, } } } - else if (! NULL_INTERVAL_P (i)) + else if (i) { after = textget (i->plist, Qread_only); @@ -2115,10 +2115,10 @@ verify_interval_modification (struct buffer *buf, } /* Run both insert hooks (just once if they're the same). */ - if (!NULL_INTERVAL_P (prev)) + if (prev) interval_insert_behind_hooks = textget (prev->plist, Qinsert_behind_hooks); - if (!NULL_INTERVAL_P (i)) + if (i) interval_insert_in_front_hooks = textget (i->plist, Qinsert_in_front_hooks); } @@ -2146,7 +2146,7 @@ verify_interval_modification (struct buffer *buf, i = next_interval (i); } /* Keep going thru the interval containing the char before END. */ - while (! NULL_INTERVAL_P (i) && i->position < end); + while (i && i->position < end); if (!inhibit_modification_hooks) { diff --git a/src/undo.c b/src/undo.c index c90e7b62405..cfb67ba5bc8 100644 --- a/src/undo.c +++ b/src/undo.c @@ -104,8 +104,9 @@ record_point (ptrdiff_t pt) if (at_boundary && current_buffer == last_boundary_buffer && last_boundary_position != pt) - BVAR (current_buffer, undo_list) - = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (make_number (last_boundary_position), + BVAR (current_buffer, undo_list))); } /* Record an insertion that just happened or is about to happen, @@ -141,8 +142,8 @@ record_insert (ptrdiff_t beg, ptrdiff_t length) XSETFASTINT (lbeg, beg); XSETINT (lend, beg + length); - BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), - BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list))); } /* Record that a deletion is about to take place, @@ -167,8 +168,8 @@ record_delete (ptrdiff_t beg, Lisp_Object string) record_point (beg); } - BVAR (current_buffer, undo_list) - = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list))); } /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. @@ -190,9 +191,9 @@ record_marker_adjustment (Lisp_Object marker, ptrdiff_t adjustment) Fundo_boundary (); last_undo_buffer = current_buffer; - BVAR (current_buffer, undo_list) - = Fcons (Fcons (marker, make_number (adjustment)), - BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (Fcons (marker, make_number (adjustment)), + BVAR (current_buffer, undo_list))); } /* Record that a replacement is about to take place, @@ -225,9 +226,9 @@ record_first_change (void) if (base_buffer->base_buffer) base_buffer = base_buffer->base_buffer; - BVAR (current_buffer, undo_list) = - Fcons (Fcons (Qt, make_lisp_time (base_buffer->modtime)), - BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (Fcons (Qt, make_lisp_time (base_buffer->modtime)), + BVAR (current_buffer, undo_list))); } /* Record a change in property PROP (whose old value was VAL) @@ -265,7 +266,8 @@ record_property_change (ptrdiff_t beg, ptrdiff_t length, XSETINT (lbeg, beg); XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); - BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (entry, BVAR (current_buffer, undo_list))); current_buffer = obuf; } @@ -288,11 +290,11 @@ but another undo command will undo to the previous boundary. */) /* If we have preallocated the cons cell to use here, use that one. */ XSETCDR (pending_boundary, BVAR (current_buffer, undo_list)); - BVAR (current_buffer, undo_list) = pending_boundary; + BSET (current_buffer, undo_list, pending_boundary); pending_boundary = Qnil; } else - BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, Fcons (Qnil, BVAR (current_buffer, undo_list))); } last_boundary_position = PT; last_boundary_buffer = current_buffer; @@ -433,7 +435,7 @@ truncate_undo_list (struct buffer *b) XSETCDR (last_boundary, Qnil); /* There's nothing we decided to keep, so clear it out. */ else - BVAR (b, undo_list) = Qnil; + BSET (b, undo_list, Qnil); unbind_to (count, Qnil); } @@ -648,8 +650,8 @@ Return what remains of the list. */) will work right. */ if (did_apply && EQ (oldlist, BVAR (current_buffer, undo_list))) - BVAR (current_buffer, undo_list) - = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)); + BSET (current_buffer, undo_list, + Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list))); UNGCPRO; return unbind_to (count, list); diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 0f5ad5498b0..05a16466dfb 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -606,6 +606,21 @@ print_load_command_name (int lc) case LC_FUNCTION_STARTS: printf ("LC_FUNCTION_STARTS"); break; +#endif +#ifdef LC_MAIN + case LC_MAIN: + printf ("LC_MAIN "); + break; +#endif +#ifdef LC_SOURCE_VERSION + case LC_SOURCE_VERSION: + printf ("LC_SOURCE_VERSION"); + break; +#endif +#ifdef LC_DYLIB_CODE_SIGN_DRS + case LC_DYLIB_CODE_SIGN_DRS: + printf ("LC_DYLIB_CODE_SIGN_DRS"); + break; #endif default: printf ("unknown "); @@ -798,8 +813,24 @@ copy_data_segment (struct load_command *lc) file. */ if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) { - if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) + extern char my_edata[]; + unsigned long my_size; + + /* The __data section is basically dumped from memory. But + initialized data in statically linked libraries are + copied from the input file. In particular, + add_image_hook.names and add_image_hook.pointers stored + by libarclite_macosx.a, are restored so that they will be + reinitialized when the dumped binary is executed. */ + my_size = (unsigned long)my_edata - sectp->addr; + if (!(sectp->addr <= (unsigned long)my_edata + && my_size <= sectp->size)) + unexec_error ("my_edata is not in section %s", SECT_DATA); + if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) unexec_error ("cannot write section %s", SECT_DATA); + if (!unexec_copy (sectp->offset + my_size, old_file_offset + my_size, + sectp->size - my_size)) + unexec_error ("cannot copy section %s", SECT_DATA); if (!unexec_write (header_offset, sectp, sizeof (struct section))) unexec_error ("cannot write section %s's header", SECT_DATA); } @@ -1147,8 +1178,9 @@ copy_dyld_info (struct load_command *lc, long delta) #endif #ifdef LC_FUNCTION_STARTS -/* Copy a LC_FUNCTION_STARTS load command from the input file to the - output file, adjusting the data offset field. */ +/* Copy a LC_FUNCTION_STARTS/LC_DYLIB_CODE_SIGN_DRS load command from + the input file to the output file, adjusting the data offset + field. */ static void copy_linkedit_data (struct load_command *lc, long delta) { @@ -1242,6 +1274,9 @@ dump_it (void) #endif #ifdef LC_FUNCTION_STARTS case LC_FUNCTION_STARTS: +#ifdef LC_DYLIB_CODE_SIGN_DRS + case LC_DYLIB_CODE_SIGN_DRS: +#endif copy_linkedit_data (lca[i], linkedit_delta); break; #endif diff --git a/src/w32.c b/src/w32.c index 5d2c8a34495..61de234cf70 100644 --- a/src/w32.c +++ b/src/w32.c @@ -116,6 +116,42 @@ typedef struct _PROCESS_MEMORY_COUNTERS_EX { } PROCESS_MEMORY_COUNTERS_EX,*PPROCESS_MEMORY_COUNTERS_EX; #endif +#include +#include + +#ifdef _MSC_VER +/* MSVC doesn't provide the definition of REPARSE_DATA_BUFFER, except + on ntifs.h, which cannot be included because it triggers conflicts + with other Windows API headers. So we define it here by hand. */ + +typedef struct _REPARSE_DATA_BUFFER { + ULONG ReparseTag; + USHORT ReparseDataLength; + USHORT Reserved; + union { + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + ULONG Flags; + WCHAR PathBuffer[1]; + } SymbolicLinkReparseBuffer; + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + WCHAR PathBuffer[1]; + } MountPointReparseBuffer; + struct { + UCHAR DataBuffer[1]; + } GenericReparseBuffer; + } DUMMYUNIONNAME; +} REPARSE_DATA_BUFFER, *PREPARSE_DATA_BUFFER; + +#endif + /* TCP connection support. */ #include #undef socket @@ -156,6 +192,11 @@ Lisp_Object QCloaded_from; void globals_of_w32 (void); static DWORD get_rid (PSID); +static int is_symlink (const char *); +static char * chase_symlinks (const char *); +static int enable_privilege (LPCTSTR, BOOL, TOKEN_PRIVILEGES *); +static int restore_privilege (TOKEN_PRIVILEGES *); +static BOOL WINAPI revert_to_self (void); /* Initialization states. @@ -173,6 +214,7 @@ static BOOL g_b_init_get_token_information; static BOOL g_b_init_lookup_account_sid; static BOOL g_b_init_get_sid_sub_authority; static BOOL g_b_init_get_sid_sub_authority_count; +static BOOL g_b_init_get_security_info; static BOOL g_b_init_get_file_security; static BOOL g_b_init_get_security_descriptor_owner; static BOOL g_b_init_get_security_descriptor_group; @@ -192,6 +234,7 @@ static BOOL g_b_init_equal_sid; static BOOL g_b_init_copy_sid; static BOOL g_b_init_get_native_system_info; static BOOL g_b_init_get_system_times; +static BOOL g_b_init_create_symbolic_link; /* BEGIN: Wrapper functions around OpenProcessToken @@ -238,6 +281,15 @@ typedef PDWORD (WINAPI * GetSidSubAuthority_Proc) ( DWORD n); typedef PUCHAR (WINAPI * GetSidSubAuthorityCount_Proc) ( PSID pSid); +typedef DWORD (WINAPI * GetSecurityInfo_Proc) ( + HANDLE handle, + SE_OBJECT_TYPE ObjectType, + SECURITY_INFORMATION SecurityInfo, + PSID *ppsidOwner, + PSID *ppsidGroup, + PACL *ppDacl, + PACL *ppSacl, + PSECURITY_DESCRIPTOR *ppSecurityDescriptor); typedef BOOL (WINAPI * GetFileSecurity_Proc) ( LPCTSTR lpFileName, SECURITY_INFORMATION RequestedInformation, @@ -298,6 +350,10 @@ typedef BOOL (WINAPI * GetSystemTimes_Proc) ( LPFILETIME lpIdleTime, LPFILETIME lpKernelTime, LPFILETIME lpUserTime); +typedef BOOLEAN (WINAPI *CreateSymbolicLink_Proc) ( + LPTSTR lpSymlinkFileName, + LPTSTR lpTargetFileName, + DWORD dwFlags); /* ** A utility function ** */ static BOOL @@ -499,6 +555,39 @@ get_sid_sub_authority_count (PSID pSid) return (s_pfn_Get_Sid_Sub_Authority_Count (pSid)); } +static DWORD WINAPI +get_security_info (HANDLE handle, + SE_OBJECT_TYPE ObjectType, + SECURITY_INFORMATION SecurityInfo, + PSID *ppsidOwner, + PSID *ppsidGroup, + PACL *ppDacl, + PACL *ppSacl, + PSECURITY_DESCRIPTOR *ppSecurityDescriptor) +{ + static GetSecurityInfo_Proc s_pfn_Get_Security_Info = NULL; + HMODULE hm_advapi32 = NULL; + if (is_windows_9x () == TRUE) + { + return FALSE; + } + if (g_b_init_get_security_info == 0) + { + g_b_init_get_security_info = 1; + hm_advapi32 = LoadLibrary ("Advapi32.dll"); + s_pfn_Get_Security_Info = + (GetSecurityInfo_Proc) GetProcAddress ( + hm_advapi32, "GetSecurityInfo"); + } + if (s_pfn_Get_Security_Info == NULL) + { + return FALSE; + } + return (s_pfn_Get_Security_Info (handle, ObjectType, SecurityInfo, + ppsidOwner, ppsidGroup, ppDacl, ppSacl, + ppSecurityDescriptor)); +} + static BOOL WINAPI get_file_security (LPCTSTR lpFileName, SECURITY_INFORMATION RequestedInformation, @@ -726,6 +815,57 @@ get_system_times (LPFILETIME lpIdleTime, return FALSE; return (s_pfn_Get_System_times (lpIdleTime, lpKernelTime, lpUserTime)); } + +static BOOLEAN WINAPI +create_symbolic_link (LPTSTR lpSymlinkFilename, + LPTSTR lpTargetFileName, + DWORD dwFlags) +{ + static CreateSymbolicLink_Proc s_pfn_Create_Symbolic_Link = NULL; + BOOLEAN retval; + + if (is_windows_9x () == TRUE) + { + errno = ENOSYS; + return 0; + } + if (g_b_init_create_symbolic_link == 0) + { + g_b_init_create_symbolic_link = 1; +#ifdef _UNICODE + s_pfn_Create_Symbolic_Link = + (CreateSymbolicLink_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), + "CreateSymbolicLinkW"); +#else + s_pfn_Create_Symbolic_Link = + (CreateSymbolicLink_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"), + "CreateSymbolicLinkA"); +#endif + } + if (s_pfn_Create_Symbolic_Link == NULL) + { + errno = ENOSYS; + return 0; + } + + retval = s_pfn_Create_Symbolic_Link (lpSymlinkFilename, lpTargetFileName, + dwFlags); + /* If we were denied creation of the symlink, try again after + enabling the SeCreateSymbolicLinkPrivilege for our process. */ + if (!retval) + { + TOKEN_PRIVILEGES priv_current; + + if (enable_privilege (SE_CREATE_SYMBOLIC_LINK_NAME, TRUE, &priv_current)) + { + retval = s_pfn_Create_Symbolic_Link (lpSymlinkFilename, lpTargetFileName, + dwFlags); + restore_privilege (&priv_current); + revert_to_self (); + } + } + return retval; +} /* Equivalent of strerror for W32 error codes. */ char * @@ -1535,6 +1675,8 @@ init_environment (char ** argv) read-only filesystem, like CD-ROM or a write-protected floppy. The only way to be really sure is to actually create a file and see if it succeeds. But I think that's too much to ask. */ + + /* MSVCRT's _access crashes with D_OK. */ if (tmp && sys_access (tmp, D_OK) == 0) { char * var = alloca (strlen (tmp) + 8); @@ -1567,17 +1709,19 @@ init_environment (char ** argv) char * def_value; } dflt_envvars[] = { + /* If the default value is NULL, we will use the value from the + outside environment or the Registry, but will not push the + variable into the Emacs environment if it is defined neither + in the Registry nor in the outside environment. */ {"HOME", "C:/"}, {"PRELOAD_WINSOCK", NULL}, {"emacs_dir", "C:/emacs"}, - {"EMACSLOADPATH", "%emacs_dir%/site-lisp;%emacs_dir%/../site-lisp;%emacs_dir%/lisp;%emacs_dir%/leim"}, + {"EMACSLOADPATH", NULL}, {"SHELL", "%emacs_dir%/bin/cmdproxy.exe"}, - {"EMACSDATA", "%emacs_dir%/etc"}, - {"EMACSPATH", "%emacs_dir%/bin"}, - /* We no longer set INFOPATH because Info-default-directory-list - is then ignored. */ - /* {"INFOPATH", "%emacs_dir%/info"}, */ - {"EMACSDOC", "%emacs_dir%/etc"}, + {"EMACSDATA", NULL}, + {"EMACSPATH", NULL}, + {"INFOPATH", NULL}, + {"EMACSDOC", NULL}, {"TERM", "cmd"}, {"LANG", NULL}, }; @@ -1635,29 +1779,10 @@ init_environment (char ** argv) } } - /* When Emacs is invoked with --no-site-lisp, we must remove the - site-lisp directories from the default value of EMACSLOADPATH. - This assumes that the site-lisp entries are at the front, and - that additional entries do exist. */ - if (no_site_lisp) - { - for (i = 0; i < N_ENV_VARS; i++) - { - if (strcmp (env_vars[i].name, "EMACSLOADPATH") == 0) - { - char *site; - while ((site = strstr (env_vars[i].def_value, "site-lisp"))) - env_vars[i].def_value = strchr (site, ';') + 1; - break; - } - } - } - #define SET_ENV_BUF_SIZE (4 * MAX_PATH) /* to cover EMACSLOADPATH */ /* Treat emacs_dir specially: set it unconditionally based on our - location, if it appears that we are running from the bin subdir - of a standard installation. */ + location. */ { char *p; char modname[MAX_PATH]; @@ -1774,6 +1899,8 @@ init_environment (char ** argv) } /* Remember the initial working directory for getwd. */ + /* FIXME: Do we need to resolve possible symlinks in startup_dir? + Does it matter anywhere in Emacs? */ if (!GetCurrentDirectory (MAXPATHLEN, startup_dir)) abort (); @@ -1793,6 +1920,8 @@ init_environment (char ** argv) init_user_info (); } +/* Called from expand-file-name when default-directory is not a string. */ + char * emacs_root_dir (void) { @@ -2187,8 +2316,15 @@ GetCachedVolumeInformation (char * root_dir) return info; } -/* Get information on the volume where name is held; set path pointer to - start of pathname in name (past UNC header\volume header if present). */ +/* Get information on the volume where NAME is held; set path pointer to + start of pathname in NAME (past UNC header\volume header if present), + if pPath is non-NULL. + + Note: if NAME includes symlinks, the information is for the volume + of the symlink, not of its target. That's because, even though + GetVolumeInformation returns information about the symlink target + of its argument, we only pass the root directory to + GetVolumeInformation, not the full NAME. */ static int get_volume_info (const char * name, const char ** pPath) { @@ -2199,7 +2335,7 @@ get_volume_info (const char * name, const char ** pPath) if (name == NULL) return FALSE; - /* find the root name of the volume if given */ + /* Find the root name of the volume if given. */ if (isalpha (name[0]) && name[1] == ':') { rootname = temp; @@ -2239,7 +2375,8 @@ get_volume_info (const char * name, const char ** pPath) } /* Determine if volume is FAT format (ie. only supports short 8.3 - names); also set path pointer to start of pathname in name. */ + names); also set path pointer to start of pathname in name, if + pPath is non-NULL. */ static int is_fat_volume (const char * name, const char ** pPath) { @@ -2248,7 +2385,8 @@ is_fat_volume (const char * name, const char ** pPath) return FALSE; } -/* Map filename to a valid 8.3 name if necessary. */ +/* Map filename to a valid 8.3 name if necessary. + The result is a pointer to a static buffer, so CAVEAT EMPTOR! */ const char * map_w32_filename (const char * name, const char ** pPath) { @@ -2278,15 +2416,10 @@ map_w32_filename (const char * name, const char ** pPath) { switch ( c ) { + case ':': case '\\': case '/': - *str++ = '\\'; - extn = 0; /* reset extension flags */ - dots = 2; /* max 2 dots */ - left = 8; /* max length 8 for main part */ - break; - case ':': - *str++ = ':'; + *str++ = (c == ':' ? ':' : '\\'); extn = 0; /* reset extension flags */ dots = 2; /* max 2 dots */ left = 8; /* max length 8 for main part */ @@ -2395,6 +2528,9 @@ opendir (char *filename) if (wnet_enum_handle != INVALID_HANDLE_VALUE) return NULL; + /* Note: We don't support traversal of UNC volumes via symlinks. + Doing so would mean punishing 99.99% of use cases by resolving + all the possible symlinks in FILENAME, recursively. */ if (is_unc_volume (filename)) { wnet_enum_handle = open_unc_volume (filename); @@ -2411,6 +2547,9 @@ opendir (char *filename) strncpy (dir_pathname, map_w32_filename (filename, NULL), MAXPATHLEN); dir_pathname[MAXPATHLEN] = '\0'; + /* Note: We don't support symlinks to file names on FAT volumes. + Doing so would mean punishing 99.99% of use cases by resolving + all the possible symlinks in FILENAME, recursively. */ dir_is_fat = is_fat_volume (filename, NULL); return dirp; @@ -2457,6 +2596,9 @@ readdir (DIR *dirp) strcat (filename, "\\"); strcat (filename, "*"); + /* Note: No need to resolve symlinks in FILENAME, because + FindFirst opens the directory that is the target of a + symlink. */ dir_find_handle = FindFirstFile (filename, &dir_find_data); if (dir_find_handle == INVALID_HANDLE_VALUE) @@ -2650,21 +2792,34 @@ sys_access (const char * path, int mode) /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its newer versions blow up when passed D_OK. */ path = map_w32_filename (path, NULL); - if (is_unc_volume (path)) - { - attributes = unc_volume_file_attributes (path); - if (attributes == -1) { - errno = EACCES; - return -1; - } - } - else if ((attributes = GetFileAttributes (path)) == -1) + /* If the last element of PATH is a symlink, we need to resolve it + to get the attributes of its target file. Note: any symlinks in + PATH elements other than the last one are transparently resolved + by GetFileAttributes below. */ + if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0) + path = chase_symlinks (path); + + if ((attributes = GetFileAttributes (path)) == -1) { DWORD w32err = GetLastError (); switch (w32err) { + case ERROR_INVALID_NAME: + case ERROR_BAD_PATHNAME: + if (is_unc_volume (path)) + { + attributes = unc_volume_file_attributes (path); + if (attributes == -1) + { + errno = EACCES; + return -1; + } + break; + } + /* FALLTHROUGH */ case ERROR_FILE_NOT_FOUND: + case ERROR_BAD_NETPATH: errno = ENOENT; break; default: @@ -2700,7 +2855,8 @@ sys_chdir (const char * path) int sys_chmod (const char * path, int mode) { - return _chmod (map_w32_filename (path, NULL), mode); + path = chase_symlinks (map_w32_filename (path, NULL)); + return _chmod (path, mode); } int @@ -2980,6 +3136,7 @@ sys_rename (const char * oldname, const char * newname) if (result < 0) { + DWORD w32err = GetLastError (); if (errno == EACCES && newname_dev != oldname_dev) @@ -2992,7 +3149,7 @@ sys_rename (const char * oldname, const char * newname) DWORD attributes; if ((attributes = GetFileAttributes (temp)) != -1 - && attributes & FILE_ATTRIBUTE_DIRECTORY) + && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; } else if (errno == EEXIST) @@ -3003,6 +3160,14 @@ sys_rename (const char * oldname, const char * newname) return result; result = rename (temp, newname); } + else if (w32err == ERROR_PRIVILEGE_NOT_HELD + && is_symlink (temp)) + { + /* This is Windows prohibiting the user from creating a + symlink in another place, since that requires + privileges. */ + errno = EPERM; + } } return result; @@ -3133,7 +3298,23 @@ generate_inode_val (const char * name) #endif static PSECURITY_DESCRIPTOR -get_file_security_desc (const char *fname) +get_file_security_desc_by_handle (HANDLE h) +{ + PSECURITY_DESCRIPTOR psd = NULL; + DWORD err; + SECURITY_INFORMATION si = OWNER_SECURITY_INFORMATION + | GROUP_SECURITY_INFORMATION /* | DACL_SECURITY_INFORMATION */ ; + + err = get_security_info (h, SE_FILE_OBJECT, si, + NULL, NULL, NULL, NULL, &psd); + if (err != ERROR_SUCCESS) + return NULL; + + return psd; +} + +static PSECURITY_DESCRIPTOR +get_file_security_desc_by_name (const char *fname) { PSECURITY_DESCRIPTOR psd = NULL; DWORD sd_len, err; @@ -3349,18 +3530,24 @@ is_slow_fs (const char *name) /* MSVC stat function can't cope with UNC names and has other bugs, so replace it with our own. This also allows us to calculate consistent - inode values without hacks in the main Emacs code. */ -int -stat (const char * path, struct stat * buf) + inode values and owner/group without hacks in the main Emacs code. */ + +static int +stat_worker (const char * path, struct stat * buf, int follow_symlinks) { - char *name, *r; + char *name, *save_name, *r; WIN32_FIND_DATA wfd; HANDLE fh; - unsigned __int64 fake_inode; + unsigned __int64 fake_inode = 0; int permission; int len; int rootdir = FALSE; PSECURITY_DESCRIPTOR psd = NULL; + int is_a_symlink = 0; + DWORD file_flags = FILE_FLAG_BACKUP_SEMANTICS; + DWORD access_rights = 0; + DWORD fattrs = 0, serialnum = 0, fs_high = 0, fs_low = 0, nlinks = 1; + FILETIME ctime, atime, wtime; if (path == NULL || buf == NULL) { @@ -3368,7 +3555,7 @@ stat (const char * path, struct stat * buf) return -1; } - name = (char *) map_w32_filename (path, &path); + save_name = name = (char *) map_w32_filename (path, &path); /* Must be valid filename, no wild cards or other invalid characters. We use _mbspbrk to support multibyte strings that might look to strpbrk as if they included literal *, ?, and other @@ -3380,99 +3567,67 @@ stat (const char * path, struct stat * buf) return -1; } - /* If name is "c:/.." or "/.." then stat "c:/" or "/". */ - r = IS_DEVICE_SEP (name[1]) ? &name[2] : name; - if (IS_DIRECTORY_SEP (r[0]) && r[1] == '.' && r[2] == '.' && r[3] == '\0') - { - r[1] = r[2] = '\0'; - } - /* Remove trailing directory separator, unless name is the root directory of a drive or UNC volume in which case ensure there is a trailing separator. */ len = strlen (name); - rootdir = (path >= name + len - 1 - && (IS_DIRECTORY_SEP (*path) || *path == 0)); name = strcpy (alloca (len + 2), name); - if (is_unc_volume (name)) - { - DWORD attrs = unc_volume_file_attributes (name); + /* Avoid a somewhat costly call to is_symlink if the filesystem + doesn't support symlinks. */ + if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) != 0) + is_a_symlink = is_symlink (name); - if (attrs == -1) - return -1; + /* Plan A: Open the file and get all the necessary information via + the resulting handle. This solves several issues in one blow: - memset (&wfd, 0, sizeof (wfd)); - wfd.dwFileAttributes = attrs; - wfd.ftCreationTime = utc_base_ft; - wfd.ftLastAccessTime = utc_base_ft; - wfd.ftLastWriteTime = utc_base_ft; - strcpy (wfd.cFileName, name); - } - else if (rootdir) - { - if (!IS_DIRECTORY_SEP (name[len-1])) - strcat (name, "\\"); - if (GetDriveType (name) < 2) - { - errno = ENOENT; - return -1; - } - memset (&wfd, 0, sizeof (wfd)); - wfd.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY; - wfd.ftCreationTime = utc_base_ft; - wfd.ftLastAccessTime = utc_base_ft; - wfd.ftLastWriteTime = utc_base_ft; - strcpy (wfd.cFileName, name); - } - else - { - if (IS_DIRECTORY_SEP (name[len-1])) - name[len - 1] = 0; + . retrieves attributes for the target of a symlink, if needed + . gets attributes of root directories and symlinks pointing to + root directories, thus avoiding the need for special-casing + these and detecting them by examining the file-name format + . retrieves more accurate attributes (e.g., non-zero size for + some directories, esp. directories that are junction points) + . correctly resolves "c:/..", "/.." and similar file names + . avoids run-time penalties for 99% of use cases - /* (This is hacky, but helps when doing file completions on - network drives.) Optimize by using information available from - active readdir if possible. */ - len = strlen (dir_pathname); - if (IS_DIRECTORY_SEP (dir_pathname[len-1])) - len--; - if (dir_find_handle != INVALID_HANDLE_VALUE - && strnicmp (name, dir_pathname, len) == 0 - && IS_DIRECTORY_SEP (name[len]) - && xstrcasecmp (name + len + 1, dir_static.d_name) == 0) - { - /* This was the last entry returned by readdir. */ - wfd = dir_find_data; - } - else - { - logon_network_drive (name); - - fh = FindFirstFile (name, &wfd); - if (fh == INVALID_HANDLE_VALUE) - { - errno = ENOENT; - return -1; - } - FindClose (fh); - } - } + Plan A is always tried first, unless the user asked not to (but + if the file is a symlink and we need to follow links, we try Plan + A even if the user asked not to). + If Plan A fails, we go to Plan B (below), where various + potentially expensive techniques must be used to handle "special" + files such as UNC volumes etc. */ if (!(NILP (Vw32_get_true_file_attributes) || (EQ (Vw32_get_true_file_attributes, Qlocal) && is_slow_fs (name))) - /* No access rights required to get info. */ - && (fh = CreateFile (name, 0, 0, NULL, OPEN_EXISTING, - FILE_FLAG_BACKUP_SEMANTICS, NULL)) - != INVALID_HANDLE_VALUE) + /* Following symlinks requires getting the info by handle. */ + || (is_a_symlink && follow_symlinks)) { + BY_HANDLE_FILE_INFORMATION info; + + if (is_a_symlink && !follow_symlinks) + file_flags |= FILE_FLAG_OPEN_REPARSE_POINT; + /* READ_CONTROL access rights are required to get security info + by handle. But if the OS doesn't support security in the + first place, we don't need to try. */ + if (is_windows_9x () != TRUE) + access_rights |= READ_CONTROL; + + fh = CreateFile (name, access_rights, 0, NULL, OPEN_EXISTING, + file_flags, NULL); + /* If CreateFile fails with READ_CONTROL, try again with zero as + access rights. */ + if (fh == INVALID_HANDLE_VALUE && access_rights) + fh = CreateFile (name, 0, 0, NULL, OPEN_EXISTING, + file_flags, NULL); + if (fh == INVALID_HANDLE_VALUE) + goto no_true_file_attributes; + /* This is more accurate in terms of getting the correct number of links, but is quite slow (it is noticeable when Emacs is making a list of file name completions). */ - BY_HANDLE_FILE_INFORMATION info; - if (GetFileInformationByHandle (fh, &info)) { - buf->st_nlink = info.nNumberOfLinks; + nlinks = info.nNumberOfLinks; /* Might as well use file index to fake inode values, but this is not guaranteed to be unique unless we keep a handle open all the time (even then there are situations where it is @@ -3481,20 +3636,53 @@ stat (const char * path, struct stat * buf) fake_inode = info.nFileIndexHigh; fake_inode <<= 32; fake_inode += info.nFileIndexLow; + serialnum = info.dwVolumeSerialNumber; + fs_high = info.nFileSizeHigh; + fs_low = info.nFileSizeLow; + ctime = info.ftCreationTime; + atime = info.ftLastAccessTime; + wtime = info.ftLastWriteTime; + fattrs = info.dwFileAttributes; } else { - buf->st_nlink = 1; - fake_inode = 0; + /* We don't go to Plan B here, because it's not clear that + it's a good idea. The only known use case where + CreateFile succeeds, but GetFileInformationByHandle fails + (with ERROR_INVALID_FUNCTION) is for character devices + such as NUL, PRN, etc. For these, switching to Plan B is + a net loss, because we lose the character device + attribute returned by GetFileType below (FindFirstFile + doesn't set that bit in the attributes), and the other + fields don't make sense for character devices anyway. + Emacs doesn't really care for non-file entities in the + context of l?stat, so neither do we. */ + + /* w32err is assigned so one could put a breakpoint here and + examine its value, when GetFileInformationByHandle + fails. */ + DWORD w32err = GetLastError (); + + switch (w32err) + { + case ERROR_FILE_NOT_FOUND: /* can this ever happen? */ + errno = ENOENT; + return -1; + } } - if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - { - buf->st_mode = S_IFDIR; - } + /* Test for a symlink before testing for a directory, since + symlinks to directories have the directory bit set, but we + don't want them to appear as directories. */ + if (is_a_symlink && !follow_symlinks) + buf->st_mode = S_IFLNK; + else if (fattrs & FILE_ATTRIBUTE_DIRECTORY) + buf->st_mode = S_IFDIR; else { - switch (GetFileType (fh)) + DWORD ftype = GetFileType (fh); + + switch (ftype) { case FILE_TYPE_DISK: buf->st_mode = S_IFREG; @@ -3508,21 +3696,143 @@ stat (const char * path, struct stat * buf) buf->st_mode = S_IFCHR; } } + /* We produce the fallback owner and group data, based on the + current user that runs Emacs, in the following cases: + + . this is Windows 9X + . getting security by handle failed, and we need to produce + information for the target of a symlink (this is better + than producing a potentially misleading info about the + symlink itself) + + If getting security by handle fails, and we don't need to + resolve symlinks, we try getting security by name. */ + if (is_windows_9x () != TRUE) + psd = get_file_security_desc_by_handle (fh); + if (psd) + { + get_file_owner_and_group (psd, name, buf); + LocalFree (psd); + } + else if (is_windows_9x () == TRUE) + get_file_owner_and_group (NULL, name, buf); + else if (!(is_a_symlink && follow_symlinks)) + { + psd = get_file_security_desc_by_name (name); + get_file_owner_and_group (psd, name, buf); + xfree (psd); + } + else + get_file_owner_and_group (NULL, name, buf); CloseHandle (fh); - psd = get_file_security_desc (name); - get_file_owner_and_group (psd, name, buf); } else { - /* Don't bother to make this information more accurate. */ - buf->st_mode = (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) ? - S_IFDIR : S_IFREG; - buf->st_nlink = 1; - fake_inode = 0; + no_true_file_attributes: + /* Plan B: Either getting a handle on the file failed, or the + caller explicitly asked us to not bother making this + information more accurate. + + Implementation note: In Plan B, we never bother to resolve + symlinks, even if we got here because we tried Plan A and + failed. That's because, even if the caller asked for extra + precision by setting Vw32_get_true_file_attributes to t, + resolving symlinks requires acquiring a file handle to the + symlink, which we already know will fail. And if the user + did not ask for extra precision, resolving symlinks will fly + in the face of that request, since the user then wants the + lightweight version of the code. */ + rootdir = (path >= save_name + len - 1 + && (IS_DIRECTORY_SEP (*path) || *path == 0)); + + /* If name is "c:/.." or "/.." then stat "c:/" or "/". */ + r = IS_DEVICE_SEP (name[1]) ? &name[2] : name; + if (IS_DIRECTORY_SEP (r[0]) + && r[1] == '.' && r[2] == '.' && r[3] == '\0') + r[1] = r[2] = '\0'; + + /* Note: If NAME is a symlink to the root of a UNC volume + (i.e. "\\SERVER"), we will not detect that here, and we will + return data about the symlink as result of FindFirst below. + This is unfortunate, but that marginal use case does not + justify a call to chase_symlinks which would impose a penalty + on all the other use cases. (We get here for symlinks to + roots of UNC volumes because CreateFile above fails for them, + unlike with symlinks to root directories X:\ of drives.) */ + if (is_unc_volume (name)) + { + fattrs = unc_volume_file_attributes (name); + if (fattrs == -1) + return -1; + + ctime = atime = wtime = utc_base_ft; + } + else if (rootdir) + { + if (!IS_DIRECTORY_SEP (name[len-1])) + strcat (name, "\\"); + if (GetDriveType (name) < 2) + { + errno = ENOENT; + return -1; + } + + fattrs = FILE_ATTRIBUTE_DIRECTORY; + ctime = atime = wtime = utc_base_ft; + } + else + { + if (IS_DIRECTORY_SEP (name[len-1])) + name[len - 1] = 0; + + /* (This is hacky, but helps when doing file completions on + network drives.) Optimize by using information available from + active readdir if possible. */ + len = strlen (dir_pathname); + if (IS_DIRECTORY_SEP (dir_pathname[len-1])) + len--; + if (dir_find_handle != INVALID_HANDLE_VALUE + && !(is_a_symlink && follow_symlinks) + && strnicmp (save_name, dir_pathname, len) == 0 + && IS_DIRECTORY_SEP (name[len]) + && xstrcasecmp (name + len + 1, dir_static.d_name) == 0) + { + /* This was the last entry returned by readdir. */ + wfd = dir_find_data; + } + else + { + logon_network_drive (name); + + fh = FindFirstFile (name, &wfd); + if (fh == INVALID_HANDLE_VALUE) + { + errno = ENOENT; + return -1; + } + FindClose (fh); + } + /* Note: if NAME is a symlink, the information we get from + FindFirstFile is for the symlink, not its target. */ + fattrs = wfd.dwFileAttributes; + ctime = wfd.ftCreationTime; + atime = wfd.ftLastAccessTime; + wtime = wfd.ftLastWriteTime; + fs_high = wfd.nFileSizeHigh; + fs_low = wfd.nFileSizeLow; + fake_inode = 0; + nlinks = 1; + serialnum = volume_info.serialnum; + } + if (is_a_symlink && !follow_symlinks) + buf->st_mode = S_IFLNK; + else if (fattrs & FILE_ATTRIBUTE_DIRECTORY) + buf->st_mode = S_IFDIR; + else + buf->st_mode = S_IFREG; get_file_owner_and_group (NULL, name, buf); } - xfree (psd); #if 0 /* Not sure if there is any point in this. */ @@ -3536,43 +3846,56 @@ stat (const char * path, struct stat * buf) } #endif - /* MSVC defines _ino_t to be short; other libc's might not. */ - if (sizeof (buf->st_ino) == 2) - buf->st_ino = fake_inode ^ (fake_inode >> 16); - else - buf->st_ino = fake_inode; + buf->st_ino = fake_inode; - /* volume_info is set indirectly by map_w32_filename */ - buf->st_dev = volume_info.serialnum; - buf->st_rdev = volume_info.serialnum; + buf->st_dev = serialnum; + buf->st_rdev = serialnum; - buf->st_size = wfd.nFileSizeHigh; + buf->st_size = fs_high; buf->st_size <<= 32; - buf->st_size += wfd.nFileSizeLow; + buf->st_size += fs_low; + buf->st_nlink = nlinks; /* Convert timestamps to Unix format. */ - buf->st_mtime = convert_time (wfd.ftLastWriteTime); - buf->st_atime = convert_time (wfd.ftLastAccessTime); + buf->st_mtime = convert_time (wtime); + buf->st_atime = convert_time (atime); if (buf->st_atime == 0) buf->st_atime = buf->st_mtime; - buf->st_ctime = convert_time (wfd.ftCreationTime); + buf->st_ctime = convert_time (ctime); if (buf->st_ctime == 0) buf->st_ctime = buf->st_mtime; /* determine rwx permissions */ - if (wfd.dwFileAttributes & FILE_ATTRIBUTE_READONLY) - permission = S_IREAD; + if (is_a_symlink && !follow_symlinks) + permission = S_IREAD | S_IWRITE | S_IEXEC; /* Posix expectations */ else - permission = S_IREAD | S_IWRITE; + { + if (fattrs & FILE_ATTRIBUTE_READONLY) + permission = S_IREAD; + else + permission = S_IREAD | S_IWRITE; - if (wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) - permission |= S_IEXEC; - else if (is_exec (name)) - permission |= S_IEXEC; + if (fattrs & FILE_ATTRIBUTE_DIRECTORY) + permission |= S_IEXEC; + else if (is_exec (name)) + permission |= S_IEXEC; + } buf->st_mode |= permission | (permission >> 3) | (permission >> 6); return 0; } +int +stat (const char * path, struct stat * buf) +{ + return stat_worker (path, buf, 1); +} + +int +lstat (const char * path, struct stat * buf) +{ + return stat_worker (path, buf, 0); +} + /* Provide fstat and utime as well as stat for consistent handling of file timestamps. */ int @@ -3713,31 +4036,460 @@ utime (const char *name, struct utimbuf *times) } -/* Symlink-related functions that always fail. Used in fileio.c and in - sysdep.c to avoid #ifdef's. */ +/* Symlink-related functions. */ +#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY +#define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1 +#endif + int -symlink (char const *dummy1, char const *dummy2) +symlink (char const *filename, char const *linkname) { - errno = ENOSYS; - return -1; + char linkfn[MAX_PATH], *tgtfn; + DWORD flags = 0; + int dir_access, filename_ends_in_slash; + + /* Diagnostics follows Posix as much as possible. */ + if (filename == NULL || linkname == NULL) + { + errno = EFAULT; + return -1; + } + if (!*filename) + { + errno = ENOENT; + return -1; + } + if (strlen (filename) > MAX_PATH || strlen (linkname) > MAX_PATH) + { + errno = ENAMETOOLONG; + return -1; + } + + strcpy (linkfn, map_w32_filename (linkname, NULL)); + if ((volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) == 0) + { + errno = EPERM; + return -1; + } + + /* Note: since empty FILENAME was already rejected, we can safely + refer to FILENAME[1]. */ + if (!(IS_DIRECTORY_SEP (filename[0]) || IS_DEVICE_SEP (filename[1]))) + { + /* Non-absolute FILENAME is understood as being relative to + LINKNAME's directory. We need to prepend that directory to + FILENAME to get correct results from sys_access below, since + otherwise it will interpret FILENAME relative to the + directory where the Emacs process runs. Note that + make-symbolic-link always makes sure LINKNAME is a fully + expanded file name. */ + char tem[MAX_PATH]; + char *p = linkfn + strlen (linkfn); + + while (p > linkfn && !IS_ANY_SEP (p[-1])) + p--; + if (p > linkfn) + strncpy (tem, linkfn, p - linkfn); + tem[p - linkfn] = '\0'; + strcat (tem, filename); + dir_access = sys_access (tem, D_OK); + } + else + dir_access = sys_access (filename, D_OK); + + /* Since Windows distinguishes between symlinks to directories and + to files, we provide a kludgey feature: if FILENAME doesn't + exist, but ends in a slash, we create a symlink to directory. If + FILENAME exists and is a directory, we always create a symlink to + directory. */ + filename_ends_in_slash = IS_DIRECTORY_SEP (filename[strlen (filename) - 1]); + if (dir_access == 0 || filename_ends_in_slash) + flags = SYMBOLIC_LINK_FLAG_DIRECTORY; + + tgtfn = (char *)map_w32_filename (filename, NULL); + if (filename_ends_in_slash) + tgtfn[strlen (tgtfn) - 1] = '\0'; + + errno = 0; + if (!create_symbolic_link (linkfn, tgtfn, flags)) + { + /* ENOSYS is set by create_symbolic_link, when it detects that + the OS doesn't support the CreateSymbolicLink API. */ + if (errno != ENOSYS) + { + DWORD w32err = GetLastError (); + + switch (w32err) + { + /* ERROR_SUCCESS is sometimes returned when LINKFN and + TGTFN point to the same file name, go figure. */ + case ERROR_SUCCESS: + case ERROR_FILE_EXISTS: + errno = EEXIST; + break; + case ERROR_ACCESS_DENIED: + errno = EACCES; + break; + case ERROR_FILE_NOT_FOUND: + case ERROR_PATH_NOT_FOUND: + case ERROR_BAD_NETPATH: + case ERROR_INVALID_REPARSE_DATA: + errno = ENOENT; + break; + case ERROR_DIRECTORY: + errno = EISDIR; + break; + case ERROR_PRIVILEGE_NOT_HELD: + case ERROR_NOT_ALL_ASSIGNED: + errno = EPERM; + break; + case ERROR_DISK_FULL: + errno = ENOSPC; + break; + default: + errno = EINVAL; + break; + } + } + return -1; + } + return 0; } +/* A quick inexpensive test of whether FILENAME identifies a file that + is a symlink. Returns non-zero if it is, zero otherwise. FILENAME + must already be in the normalized form returned by + map_w32_filename. + + Note: for repeated operations on many files, it is best to test + whether the underlying volume actually supports symlinks, by + testing the FILE_SUPPORTS_REPARSE_POINTS bit in volume's flags, and + avoid the call to this function if it doesn't. That's because the + call to GetFileAttributes takes a non-negligible time, expecially + on non-local or removable filesystems. See stat_worker for an + example of how to do that. */ +static int +is_symlink (const char *filename) +{ + DWORD attrs; + WIN32_FIND_DATA wfd; + HANDLE fh; + + attrs = GetFileAttributes (filename); + if (attrs == -1) + { + DWORD w32err = GetLastError (); + + switch (w32err) + { + case ERROR_BAD_NETPATH: /* network share, can't be a symlink */ + break; + case ERROR_ACCESS_DENIED: + errno = EACCES; + break; + case ERROR_FILE_NOT_FOUND: + case ERROR_PATH_NOT_FOUND: + default: + errno = ENOENT; + break; + } + return 0; + } + if ((attrs & FILE_ATTRIBUTE_REPARSE_POINT) == 0) + return 0; + logon_network_drive (filename); + fh = FindFirstFile (filename, &wfd); + if (fh == INVALID_HANDLE_VALUE) + return 0; + FindClose (fh); + return (wfd.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT) != 0 + && (wfd.dwReserved0 & IO_REPARSE_TAG_SYMLINK) == IO_REPARSE_TAG_SYMLINK; +} + +/* If NAME identifies a symbolic link, copy into BUF the file name of + the symlink's target. Copy at most BUF_SIZE bytes, and do NOT + null-terminate the target name, even if it fits. Return the number + of bytes copied, or -1 if NAME is not a symlink or any error was + encountered while resolving it. The file name copied into BUF is + encoded in the current ANSI codepage. */ ssize_t -readlink (const char *name, char *dummy1, size_t dummy2) +readlink (const char *name, char *buf, size_t buf_size) { - /* `access' is much faster than `stat' on MS-Windows. */ - if (sys_access (name, 0) == 0) - errno = EINVAL; - return -1; + const char *path; + TOKEN_PRIVILEGES privs; + int restore_privs = 0; + HANDLE sh; + ssize_t retval; + + if (name == NULL) + { + errno = EFAULT; + return -1; + } + if (!*name) + { + errno = ENOENT; + return -1; + } + + path = map_w32_filename (name, NULL); + + if (strlen (path) > MAX_PATH) + { + errno = ENAMETOOLONG; + return -1; + } + + errno = 0; + if (is_windows_9x () == TRUE + || (volume_info.flags & FILE_SUPPORTS_REPARSE_POINTS) == 0 + || !is_symlink (path)) + { + if (!errno) + errno = EINVAL; /* not a symlink */ + return -1; + } + + /* Done with simple tests, now we're in for some _real_ work. */ + if (enable_privilege (SE_BACKUP_NAME, TRUE, &privs)) + restore_privs = 1; + /* Implementation note: From here and onward, don't return early, + since that will fail to restore the original set of privileges of + the calling thread. */ + + retval = -1; /* not too optimistic, are we? */ + + /* Note: In the next call to CreateFile, we use zero as the 2nd + argument because, when the symlink is a hidden/system file, + e.g. 'C:\Users\All Users', GENERIC_READ fails with + ERROR_ACCESS_DENIED. Zero seems to work just fine, both for file + and directory symlinks. */ + sh = CreateFile (path, 0, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, + NULL); + if (sh != INVALID_HANDLE_VALUE) + { + BYTE reparse_buf[MAXIMUM_REPARSE_DATA_BUFFER_SIZE]; + REPARSE_DATA_BUFFER *reparse_data = (REPARSE_DATA_BUFFER *)&reparse_buf[0]; + DWORD retbytes; + + if (!DeviceIoControl (sh, FSCTL_GET_REPARSE_POINT, NULL, 0, + reparse_buf, MAXIMUM_REPARSE_DATA_BUFFER_SIZE, + &retbytes, NULL)) + errno = EIO; + else if (reparse_data->ReparseTag != IO_REPARSE_TAG_SYMLINK) + errno = EINVAL; + else + { + /* Copy the link target name, in wide characters, fro + reparse_data, then convert it to multibyte encoding in + the current locale's codepage. */ + WCHAR *lwname; + BYTE lname[MAX_PATH]; + USHORT lname_len; + USHORT lwname_len = + reparse_data->SymbolicLinkReparseBuffer.PrintNameLength; + WCHAR *lwname_src = + reparse_data->SymbolicLinkReparseBuffer.PathBuffer + + reparse_data->SymbolicLinkReparseBuffer.PrintNameOffset/sizeof(WCHAR); + + /* According to MSDN, PrintNameLength does not include the + terminating null character. */ + lwname = alloca ((lwname_len + 1) * sizeof(WCHAR)); + memcpy (lwname, lwname_src, lwname_len); + lwname[lwname_len/sizeof(WCHAR)] = 0; /* null-terminate */ + + /* FIXME: Should we use the current file-name coding system + instead of the fixed value of the ANSI codepage? */ + lname_len = WideCharToMultiByte (w32_ansi_code_page, 0, lwname, -1, + lname, MAX_PATH, NULL, NULL); + if (!lname_len) + { + /* WideCharToMultiByte failed. */ + DWORD w32err1 = GetLastError (); + + switch (w32err1) + { + case ERROR_INSUFFICIENT_BUFFER: + errno = ENAMETOOLONG; + break; + case ERROR_INVALID_PARAMETER: + errno = EFAULT; + break; + case ERROR_NO_UNICODE_TRANSLATION: + errno = ENOENT; + break; + default: + errno = EINVAL; + break; + } + } + else + { + size_t size_to_copy = buf_size; + BYTE *p = lname; + BYTE *pend = p + lname_len; + + /* Normalize like dostounix_filename does, but we don't + want to assume that lname is null-terminated. */ + if (*p && p[1] == ':' && *p >= 'A' && *p <= 'Z') + *p += 'a' - 'A'; + while (p <= pend) + { + if (*p == '\\') + *p = '/'; + ++p; + } + /* Testing for null-terminated LNAME is paranoia: + WideCharToMultiByte should always return a + null-terminated string when its 4th argument is -1 + and its 3rd argument is null-terminated (which they + are, see above). */ + if (lname[lname_len - 1] == '\0') + lname_len--; + if (lname_len <= buf_size) + size_to_copy = lname_len; + strncpy (buf, lname, size_to_copy); + /* Success! */ + retval = size_to_copy; + } + } + CloseHandle (sh); + } + else + { + /* CreateFile failed. */ + DWORD w32err2 = GetLastError (); + + switch (w32err2) + { + case ERROR_FILE_NOT_FOUND: + case ERROR_PATH_NOT_FOUND: + errno = ENOENT; + break; + case ERROR_ACCESS_DENIED: + case ERROR_TOO_MANY_OPEN_FILES: + errno = EACCES; + break; + default: + errno = EPERM; + break; + } + } + if (restore_privs) + { + restore_privilege (&privs); + revert_to_self (); + } + + return retval; } +/* If FILE is a symlink, return its target (stored in a static + buffer); otherwise return FILE. + + This function repeatedly resolves symlinks in the last component of + a chain of symlink file names, as in foo -> bar -> baz -> ..., + until it arrives at a file whose last component is not a symlink, + or some error occurs. It returns the target of the last + successfully resolved symlink in the chain. If it succeeds to + resolve even a single symlink, the value returned is an absolute + file name with backslashes (result of GetFullPathName). By + contrast, if the original FILE is returned, it is unaltered. + + Note: This function can set errno even if it succeeds. + + Implementation note: we only resolve the last portion ("basename") + of the argument FILE and of each following file in the chain, + disregarding any possible symlinks in its leading directories. + This is because Windows system calls and library functions + transparently resolve symlinks in leading directories and return + correct information, as long as the basename is not a symlink. */ +static char * +chase_symlinks (const char *file) +{ + static char target[MAX_PATH]; + char link[MAX_PATH]; + ssize_t res, link_len; + int loop_count = 0; + + if (is_windows_9x () == TRUE || !is_symlink (file)) + return (char *)file; + + if ((link_len = GetFullPathName (file, MAX_PATH, link, NULL)) == 0) + return (char *)file; + + target[0] = '\0'; + do { + + /* Remove trailing slashes, as we want to resolve the last + non-trivial part of the link name. */ + while (link_len > 3 && IS_DIRECTORY_SEP (link[link_len-1])) + link[link_len--] = '\0'; + + res = readlink (link, target, MAX_PATH); + if (res > 0) + { + target[res] = '\0'; + if (!(IS_DEVICE_SEP (target[1]) + || (IS_DIRECTORY_SEP (target[0]) && IS_DIRECTORY_SEP (target[1])))) + { + /* Target is relative. Append it to the directory part of + the symlink, then copy the result back to target. */ + char *p = link + link_len; + + while (p > link && !IS_ANY_SEP (p[-1])) + p--; + strcpy (p, target); + strcpy (target, link); + } + /* Resolve any "." and ".." to get a fully-qualified file name + in link[] again. */ + link_len = GetFullPathName (target, MAX_PATH, link, NULL); + } + } while (res > 0 && link_len > 0 && ++loop_count <= 100); + + if (loop_count > 100) + errno = ELOOP; + + if (target[0] == '\0') /* not a single call to readlink succeeded */ + return (char *)file; + return target; +} + +/* MS-Windows version of careadlinkat (cf. ../lib/careadlinkat.c). We + have a fixed max size for file names, so we don't need the kind of + alloc/malloc/realloc dance the gnulib version does. We also don't + support FD-relative symlinks. */ char * careadlinkat (int fd, char const *filename, char *buffer, size_t buffer_size, struct allocator const *alloc, ssize_t (*preadlinkat) (int, char const *, char *, size_t)) { - errno = ENOSYS; + char linkname[MAX_PATH]; + ssize_t link_size; + + if (fd != AT_FDCWD) + { + errno = EINVAL; + return NULL; + } + + link_size = preadlinkat (fd, filename, linkname, sizeof(linkname)); + + if (link_size > 0) + { + char *retval = buffer; + + linkname[link_size++] = '\0'; + if (link_size > buffer_size) + retval = (char *)(alloc ? alloc->allocate : xmalloc) (link_size); + if (retval) + memcpy (retval, linkname, link_size); + + return retval; + } return NULL; } @@ -5848,7 +6600,7 @@ w32_delayed_load (Lisp_Object libraries, Lisp_Object library_id) } -static void +void check_windows_init_file (void) { /* A common indication that Emacs is not installed properly is when @@ -5860,19 +6612,14 @@ check_windows_init_file (void) loadup.el. */ && NILP (Vpurify_flag)) { - Lisp_Object objs[2]; - Lisp_Object full_load_path; Lisp_Object init_file; int fd; - objs[0] = Vload_path; - objs[1] = decode_env_path (0, (getenv ("EMACSLOADPATH"))); - full_load_path = Fappend (2, objs); init_file = build_string ("term/w32-win"); - fd = openp (full_load_path, init_file, Fget_load_suffixes (), NULL, Qnil); + fd = openp (Vload_path, init_file, Fget_load_suffixes (), NULL, Qnil); if (fd < 0) { - Lisp_Object load_path_print = Fprin1_to_string (full_load_path, Qnil); + Lisp_Object load_path_print = Fprin1_to_string (Vload_path, Qnil); char *init_file_name = SDATA (init_file); char *load_path = SDATA (load_path_print); char *buffer = alloca (1024 @@ -6011,9 +6758,6 @@ init_ntproc (void) /* Reset the volume info cache. */ volume_cache = NULL; } - - /* Check to see if Emacs has been installed correctly. */ - check_windows_init_file (); } /* @@ -6060,6 +6804,7 @@ globals_of_w32 (void) g_b_init_lookup_account_sid = 0; g_b_init_get_sid_sub_authority = 0; g_b_init_get_sid_sub_authority_count = 0; + g_b_init_get_security_info = 0; g_b_init_get_file_security = 0; g_b_init_get_security_descriptor_owner = 0; g_b_init_get_security_descriptor_group = 0; @@ -6079,6 +6824,7 @@ globals_of_w32 (void) g_b_init_get_length_sid = 0; g_b_init_get_native_system_info = 0; g_b_init_get_system_times = 0; + g_b_init_create_symbolic_link = 0; num_of_processors = 0; /* The following sets a handler for shutdown notifications for console apps. This actually applies to Emacs in both console and @@ -6144,7 +6890,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) error ("Not a serial process"); hnd = fd_info[ p->outfd ].hnd; - childp2 = Fcopy_sequence (PVAR (p, childp)); + childp2 = Fcopy_sequence (p->childp); /* Initialize timeouts for blocking read and blocking write. */ if (!GetCommTimeouts (hnd, &ct)) @@ -6173,7 +6919,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (!NILP (Fplist_member (contact, QCspeed))) tem = Fplist_get (contact, QCspeed); else - tem = Fplist_get (PVAR (p, childp), QCspeed); + tem = Fplist_get (p->childp, QCspeed); CHECK_NUMBER (tem); dcb.BaudRate = XINT (tem); childp2 = Fplist_put (childp2, QCspeed, tem); @@ -6182,7 +6928,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (!NILP (Fplist_member (contact, QCbytesize))) tem = Fplist_get (contact, QCbytesize); else - tem = Fplist_get (PVAR (p, childp), QCbytesize); + tem = Fplist_get (p->childp, QCbytesize); if (NILP (tem)) tem = make_number (8); CHECK_NUMBER (tem); @@ -6196,7 +6942,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (!NILP (Fplist_member (contact, QCparity))) tem = Fplist_get (contact, QCparity); else - tem = Fplist_get (PVAR (p, childp), QCparity); + tem = Fplist_get (p->childp, QCparity); if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd)) error (":parity must be nil (no parity), `even', or `odd'"); dcb.fParity = FALSE; @@ -6226,7 +6972,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (!NILP (Fplist_member (contact, QCstopbits))) tem = Fplist_get (contact, QCstopbits); else - tem = Fplist_get (PVAR (p, childp), QCstopbits); + tem = Fplist_get (p->childp, QCstopbits); if (NILP (tem)) tem = make_number (1); CHECK_NUMBER (tem); @@ -6243,7 +6989,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) if (!NILP (Fplist_member (contact, QCflowcontrol))) tem = Fplist_get (contact, QCflowcontrol); else - tem = Fplist_get (PVAR (p, childp), QCflowcontrol); + tem = Fplist_get (p->childp, QCflowcontrol); if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw)) error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'"); dcb.fOutxCtsFlow = FALSE; @@ -6277,7 +7023,7 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) error ("SetCommState() failed"); childp2 = Fplist_put (childp2, QCsummary, build_string (summary)); - PVAR (p, childp) = childp2; + PSET (p, childp, childp2); } #ifdef HAVE_GNUTLS diff --git a/src/w32.h b/src/w32.h index 2866cb2f34a..73d57a65a4a 100644 --- a/src/w32.h +++ b/src/w32.h @@ -140,6 +140,7 @@ extern void syms_of_w32menu (void); extern void globals_of_w32menu (void); extern void syms_of_fontset (void); extern void syms_of_w32font (void); +extern void check_windows_init_file (void); extern int _sys_read_ahead (int fd); extern int _sys_wait_accept (int fd); diff --git a/src/w32fns.c b/src/w32fns.c index bbcda21adee..7779f032104 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -93,7 +93,6 @@ static HWND hourglass_hwnd = NULL; static int w32_in_use; -Lisp_Object Qnone; Lisp_Object Qsuppress_icon; Lisp_Object Qundefined_color; Lisp_Object Qcancel_timer; @@ -189,6 +188,8 @@ static int image_cache_refcount, dpyinfo_refcount; static HWND w32_visible_system_caret_hwnd; +static int w32_unicode_gui; + /* From w32menu.c */ extern HMENU current_popup_menu; static int menubar_in_use = 0; @@ -1489,7 +1490,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) else if (!NILP (arg) || NILP (oldval)) return; - FVAR (f, icon_name) = arg; + FSET (f, icon_name, arg); #if 0 if (f->output_data.w32->icon_bitmap != 0) @@ -1498,11 +1499,11 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) BLOCK_INPUT; result = x_text_icon (f, - SSDATA ((!NILP (FVAR (f, icon_name)) - ? FVAR (f, icon_name) - : !NILP (FVAR (f, title)) - ? FVAR (f, title) - : FVAR (f, name)))); + SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : !NILP (f->title) + ? f->title + : f->name))); if (result) { @@ -1631,8 +1632,8 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } UNBLOCK_INPUT; - if (WINDOWP (FVAR (f, tool_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, tool_bar_window))->current_matrix); + if (WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); } run_window_configuration_change_hook (f); @@ -1674,7 +1675,7 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit) /* Check for no change needed in this very common case before we do any consing. */ if (!strcmp (FRAME_W32_DISPLAY_INFO (f)->w32_id_name, - SDATA (FVAR (f, name)))) + SDATA (f->name))) return; name = build_string (FRAME_W32_DISPLAY_INFO (f)->w32_id_name); } @@ -1682,15 +1683,15 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit) CHECK_STRING (name); /* Don't change the name if it's already NAME. */ - if (! NILP (Fstring_equal (name, FVAR (f, name)))) + if (! NILP (Fstring_equal (name, f->name))) return; - FVAR (f, name) = name; + FSET (f, name, name); /* For setting the frame title, the title parameter should override the name parameter. */ - if (! NILP (FVAR (f, title))) - name = FVAR (f, title); + if (! NILP (f->title)) + name = f->title; if (FRAME_W32_WINDOW (f)) { @@ -1728,15 +1729,15 @@ void x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) { /* Don't change the title if it's already NAME. */ - if (EQ (name, FVAR (f, title))) + if (EQ (name, f->title)) return; update_mode_lines = 1; - FVAR (f, title) = name; + FSET (f, title, name); if (NILP (name)) - name = FVAR (f, name); + name = f->name; if (FRAME_W32_WINDOW (f)) { @@ -1780,23 +1781,37 @@ w32_load_cursor (LPCTSTR name) static LRESULT CALLBACK w32_wnd_proc (HWND, UINT, WPARAM, LPARAM); +#define INIT_WINDOW_CLASS(WC) \ + (WC).style = CS_HREDRAW | CS_VREDRAW; \ + (WC).lpfnWndProc = (WNDPROC) w32_wnd_proc; \ + (WC).cbClsExtra = 0; \ + (WC).cbWndExtra = WND_EXTRA_BYTES; \ + (WC).hInstance = hinst; \ + (WC).hIcon = LoadIcon (hinst, EMACS_CLASS); \ + (WC).hCursor = w32_load_cursor (IDC_ARROW); \ + (WC).hbrBackground = NULL; \ + (WC).lpszMenuName = NULL; \ + static BOOL w32_init_class (HINSTANCE hinst) { - WNDCLASS wc; - wc.style = CS_HREDRAW | CS_VREDRAW; - wc.lpfnWndProc = (WNDPROC) w32_wnd_proc; - wc.cbClsExtra = 0; - wc.cbWndExtra = WND_EXTRA_BYTES; - wc.hInstance = hinst; - wc.hIcon = LoadIcon (hinst, EMACS_CLASS); - wc.hCursor = w32_load_cursor (IDC_ARROW); - wc.hbrBackground = NULL; /* GetStockObject (WHITE_BRUSH); */ - wc.lpszMenuName = NULL; - wc.lpszClassName = EMACS_CLASS; + if (w32_unicode_gui) + { + WNDCLASSW uwc; + INIT_WINDOW_CLASS(uwc); + uwc.lpszClassName = L"Emacs"; - return (RegisterClass (&wc)); + return RegisterClassW (&uwc); + } + else + { + WNDCLASS wc; + INIT_WINDOW_CLASS(wc); + wc.lpszClassName = EMACS_CLASS; + + return RegisterClassA (&wc); + } } static HWND @@ -2246,7 +2261,7 @@ w32_msg_pump (deferred_msg * msg_buf) msh_mousewheel = RegisterWindowMessage (MSH_MOUSEWHEEL); - while (GetMessage (&msg, NULL, 0, 0)) + while ((w32_unicode_gui ? GetMessageW : GetMessageA) (&msg, NULL, 0, 0)) { if (msg.hwnd == NULL) { @@ -2341,7 +2356,10 @@ w32_msg_pump (deferred_msg * msg_buf) } else { - DispatchMessage (&msg); + if (w32_unicode_gui) + DispatchMessageW (&msg); + else + DispatchMessageA (&msg); } /* Exit nested loop when our deferred message has completed. */ @@ -2918,8 +2936,18 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) case WM_SYSCHAR: case WM_CHAR: - post_character_message (hwnd, msg, wParam, lParam, - w32_get_key_modifiers (wParam, lParam)); + if (wParam > 255 ) + { + W32Msg wmsg; + + wmsg.dwModifiers = w32_get_key_modifiers (wParam, lParam); + signal_user_input (); + my_post_msg (&wmsg, hwnd, WM_UNICHAR, wParam, lParam); + + } + else + post_character_message (hwnd, msg, wParam, lParam, + w32_get_key_modifiers (wParam, lParam)); break; case WM_UNICHAR: @@ -3801,7 +3829,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) } dflt: - return DefWindowProc (hwnd, msg, wParam, lParam); + return (w32_unicode_gui ? DefWindowProcW : DefWindowProcA) (hwnd, msg, wParam, lParam); } /* The most common default return code for handled messages is 0. */ @@ -3896,8 +3924,8 @@ w32_window (struct frame *f, long window_prompting, int minibuffer_only) int explicit = f->explicit_name; f->explicit_name = 0; - name = FVAR (f, name); - FVAR (f, name) = Qnil; + name = f->name; + FSET (f, name, Qnil); x_set_name (f, name, explicit); } @@ -3944,9 +3972,9 @@ x_icon (struct frame *f, Lisp_Object parms) ? IconicState : NormalState)); - x_text_icon (f, SSDATA ((!NILP (FVAR (f, icon_name)) - ? FVAR (f, icon_name) - : FVAR (f, name)))); + x_text_icon (f, SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : f->name))); #endif UNBLOCK_INPUT; @@ -4146,11 +4174,11 @@ This function is an internal primitive--use `make-frame' instead. */) f->output_data.w32 = xzalloc (sizeof (struct w32_output)); FRAME_FONTSET (f) = -1; - FVAR (f, icon_name) - = x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title", - RES_TYPE_STRING); - if (! STRINGP (FVAR (f, icon_name))) - FVAR (f, icon_name) = Qnil; + FSET (f, icon_name, + x_get_arg (dpyinfo, parameters, Qicon_name, "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name)) + FSET (f, icon_name, Qnil); /* FRAME_W32_DISPLAY_INFO (f) = dpyinfo; */ @@ -4179,12 +4207,12 @@ This function is an internal primitive--use `make-frame' instead. */) be set. */ if (EQ (name, Qunbound) || NILP (name)) { - FVAR (f, name) = build_string (dpyinfo->w32_id_name); + FSET (f, name, build_string (dpyinfo->w32_id_name)); f->explicit_name = 0; } else { - FVAR (f, name) = name; + FSET (f, name, name); f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); @@ -4353,13 +4381,13 @@ This function is an internal primitive--use `make-frame' instead. */) if (FRAME_HAS_MINIBUF_P (f) && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) - KVAR (kb, Vdefault_minibuffer_frame) = frame; + KSET (kb, Vdefault_minibuffer_frame, frame); /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ for (tem = parameters; CONSP (tem); tem = XCDR (tem)) if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) - FVAR (f, param_alist) = Fcons (XCAR (tem), FVAR (f, param_alist)); + FSET (f, param_alist, Fcons (XCAR (tem), f->param_alist)); UNGCPRO; @@ -5209,10 +5237,12 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, XSETFRAME (frame, f); buffer = Fget_buffer_create (build_string (" *tip*")); - Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - BVAR (current_buffer, truncate_lines) = Qnil; + BSET (current_buffer, truncate_lines, Qnil); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5231,7 +5261,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, f->output_data.w32 = xzalloc (sizeof (struct w32_output)); FRAME_FONTSET (f) = -1; - FVAR (f, icon_name) = Qnil; + FSET (f, icon_name, Qnil); #ifdef GLYPH_DEBUG image_cache_refcount = @@ -5246,12 +5276,12 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, be set. */ if (EQ (name, Qunbound) || NILP (name)) { - FVAR (f, name) = build_string (dpyinfo->w32_id_name); + FSET (f, name, build_string (dpyinfo->w32_id_name)); f->explicit_name = 0; } else { - FVAR (f, name) = name; + FSET (f, name, name); f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); @@ -5617,7 +5647,8 @@ Text larger than the specified size is clipped. */) /* Set up the frame's root window. */ w = XWINDOW (FRAME_ROOT_WINDOW (f)); - WVAR (w, left_col) = WVAR (w, top_line) = make_number (0); + WSET (w, left_col, make_number (0)); + WSET (w, top_line, make_number (0)); if (CONSP (Vx_max_tooltip_size) && INTEGERP (XCAR (Vx_max_tooltip_size)) @@ -5625,23 +5656,23 @@ Text larger than the specified size is clipped. */) && INTEGERP (XCDR (Vx_max_tooltip_size)) && XINT (XCDR (Vx_max_tooltip_size)) > 0) { - WVAR (w, total_cols) = XCAR (Vx_max_tooltip_size); - WVAR (w, total_lines) = XCDR (Vx_max_tooltip_size); + WSET (w, total_cols, XCAR (Vx_max_tooltip_size)); + WSET (w, total_lines, XCDR (Vx_max_tooltip_size)); } else { - WVAR (w, total_cols) = make_number (80); - WVAR (w, total_lines) = make_number (40); + WSET (w, total_cols, make_number (80)); + WSET (w, total_lines, make_number (40)); } - FRAME_TOTAL_COLS (f) = XINT (WVAR (w, total_cols)); + FRAME_TOTAL_COLS (f) = XINT (w->total_cols); adjust_glyphs (f); w->pseudo_window_p = 1; /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; - set_buffer_internal_1 (XBUFFER (WVAR (XWINDOW (FRAME_ROOT_WINDOW (f)), buffer))); - BVAR (current_buffer, truncate_lines) = Qnil; + set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); + BSET (current_buffer, truncate_lines, Qnil); clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); @@ -5702,7 +5733,7 @@ Text larger than the specified size is clipped. */) /* w->total_cols and FRAME_TOTAL_COLS want the width in columns, not in pixels. */ width /= WINDOW_FRAME_COLUMN_WIDTH (w); - WVAR (w, total_cols) = make_number (width); + WSET (w, total_cols, make_number (width)); FRAME_TOTAL_COLS (f) = width; adjust_glyphs (f); w->pseudo_window_p = 1; @@ -6778,7 +6809,6 @@ syms_of_w32fns (void) w32_visible_system_caret_hwnd = NULL; - DEFSYM (Qnone, "none"); DEFSYM (Qsuppress_icon, "suppress-icon"); DEFSYM (Qundefined_color, "undefined-color"); DEFSYM (Qcancel_timer, "cancel-timer"); @@ -7153,6 +7183,11 @@ globals_of_w32fns (void) doc: /* The ANSI code page used by the system. */); w32_ansi_code_page = GetACP (); + if (os_subtype == OS_NT) + w32_unicode_gui = 1; + else + w32_unicode_gui = 0; + /* MessageBox does not work without this when linked to comctl32.dll 6.0. */ InitCommonControls (); diff --git a/src/w32font.c b/src/w32font.c index fd24a90d60b..cfd453282dd 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -62,7 +62,6 @@ static Lisp_Object Qserif, Qscript, Qdecorative; static Lisp_Object Qraster, Qoutline, Qunknown; /* antialiasing */ -extern Lisp_Object Qnone; /* reuse from w32fns.c */ static Lisp_Object Qstandard, Qsubpixel, Qnatural; /* languages */ @@ -235,8 +234,7 @@ get_outline_metrics_w(HDC hdc, UINT cbData, LPOUTLINETEXTMETRICW lpotmw) s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc) GetProcAddress (hm_unicows, "GetOutlineTextMetricsW"); } - if (s_pfn_Get_Outline_Text_MetricsW == NULL) - abort (); /* cannot happen */ + eassert (s_pfn_Get_Outline_Text_MetricsW != NULL); return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw); } @@ -253,8 +251,7 @@ get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw) s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc) GetProcAddress (hm_unicows, "GetTextMetricsW"); } - if (s_pfn_Get_Text_MetricsW == NULL) - abort (); /* cannot happen */ + eassert (s_pfn_Get_Text_MetricsW != NULL); return s_pfn_Get_Text_MetricsW (hdc, lptmw); } @@ -272,8 +269,7 @@ get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat, LPGLYPHMETRICS lpgm, s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc) GetProcAddress (hm_unicows, "GetGlyphOutlineW"); } - if (s_pfn_Get_Glyph_OutlineW == NULL) - abort (); /* cannot happen */ + eassert (s_pfn_Get_Glyph_OutlineW != NULL); return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer, lpvBuffer, lpmat2); } diff --git a/src/w32menu.c b/src/w32menu.c index 4545533c999..02302c2d594 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -276,8 +276,8 @@ menubar_selection_callback (FRAME_PTR f, void * client_data) if (!f) return; entry = Qnil; - subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * sizeof (Lisp_Object)); - vector = FVAR (f, menu_bar_vector); + subprefix_stack = (Lisp_Object *) alloca (f->menu_bar_items_used * word_size); + vector = f->menu_bar_vector; prefix = Qnil; i = 0; while (i < f->menu_bar_items_used) @@ -387,14 +387,14 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) int previous_menu_items_used = f->menu_bar_items_used; Lisp_Object *previous_items = (Lisp_Object *) alloca (previous_menu_items_used - * sizeof (Lisp_Object)); + * word_size); /* If we are making a new widget, its contents are empty, do always reinitialize them. */ if (! menubar_widget) previous_menu_items_used = 0; - buffer = WVAR (XWINDOW (FRAME_SELECTED_WINDOW (f)), buffer); + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; specbind (Qinhibit_quit, Qt); /* Don't let the debugger step into this code because it is not reentrant. */ @@ -413,20 +413,20 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) /* Run the hooks. */ safe_run_hooks (Qactivate_menubar_hook); safe_run_hooks (Qmenu_bar_update_hook); - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); items = FRAME_MENU_BAR_ITEMS (f); /* Save the frame's previous menu bar contents data. */ if (previous_menu_items_used) - memcpy (previous_items, XVECTOR (FVAR (f, menu_bar_vector))->contents, - previous_menu_items_used * sizeof (Lisp_Object)); + memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents, + previous_menu_items_used * word_size); /* Fill in menu_items with the current menu bar contents. This can evaluate Lisp code. */ save_menu_items (); - menu_items = FVAR (f, menu_bar_vector); + menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; submenu_start = (int *) alloca (ASIZE (items) * sizeof (int)); submenu_end = (int *) alloca (ASIZE (items) * sizeof (int)); @@ -500,7 +500,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) return; } - FVAR (f, menu_bar_vector) = menu_items; + FSET (f, menu_bar_vector, menu_items); f->menu_bar_items_used = menu_items_used; /* This undoes save_menu_items. */ @@ -615,7 +615,7 @@ initialize_frame_menubar (FRAME_PTR f) { /* This function is called before the first chance to redisplay the frame. It has to be, so the frame will have the right size. */ - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); set_frame_menubar (f, 1, 1); } @@ -665,7 +665,7 @@ w32_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, widget_value **submenu_stack = (widget_value **) alloca (menu_items_used * sizeof (widget_value *)); Lisp_Object *subprefix_stack - = (Lisp_Object *) alloca (menu_items_used * sizeof (Lisp_Object)); + = (Lisp_Object *) alloca (menu_items_used * word_size); int submenu_depth = 0; int first_pane; @@ -1062,7 +1062,7 @@ w32_dialog_show (FRAME_PTR f, int keymaps, if (!NILP (descrip)) wv->key = SSDATA (descrip); wv->value = SSDATA (item_name); - wv->call_data = (void *) &AREF (menu_items, i); + wv->call_data = aref_addr (menu_items, i); wv->enabled = !NILP (enable); wv->help = Qnil; prev_wv = wv; @@ -1243,7 +1243,7 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header) one utf16 word, so we cannot simply use the character length of temp. */ int utf8_len = strlen (utf8_text); - SAFE_ALLOCA (text, WCHAR *, (utf8_len + 1) * sizeof (WCHAR)); + text = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR)); utf8to16 (utf8_text, utf8_len, text); } else @@ -1386,8 +1386,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) if (wv->key != NULL) { - SAFE_ALLOCA (out_string, char *, - strlen (wv->name) + strlen (wv->key) + 2); + out_string = SAFE_ALLOCA (strlen (wv->name) + strlen (wv->key) + 2); strcpy (out_string, wv->name); strcat (out_string, "\t"); strcat (out_string, wv->key); @@ -1421,7 +1420,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) if (nlen > orig_len) { p = out_string; - SAFE_ALLOCA (out_string, char *, nlen + 1); + out_string = SAFE_ALLOCA (nlen + 1); q = out_string; while (*p) { @@ -1481,7 +1480,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) if (fuFlags & MF_OWNERDRAW) utf16_string = local_alloc ((utf8_len + 1) * sizeof (WCHAR)); else - SAFE_ALLOCA (utf16_string, WCHAR *, (utf8_len + 1) * sizeof (WCHAR)); + utf16_string = SAFE_ALLOCA ((utf8_len + 1) * sizeof (WCHAR)); utf8to16 (out_string, utf8_len, utf16_string); return_value = unicode_append_menu (menu, fuFlags, diff --git a/src/w32proc.c b/src/w32proc.c index cfc82fa2c47..33aed5eb8e3 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -549,7 +549,7 @@ sys_wait (int *status) /* Report the status of the synchronous process. */ if (WIFEXITED (retval)) - synch_process_retcode = WRETCODE (retval); + synch_process_retcode = WEXITSTATUS (retval); else if (WIFSIGNALED (retval)) { int code = WTERMSIG (retval); diff --git a/src/w32term.c b/src/w32term.c index 6b87ca4e88c..7da9433d3f1 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -649,7 +649,7 @@ static void x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritten_p) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (WVAR (w, frame))); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); if (!w->pseudo_window_p) { @@ -754,7 +754,7 @@ x_after_update_window_line (struct glyph_row *desired_row) overhead is very small. */ if (windows_or_buffers_changed && desired_row->full_width_p - && (f = XFRAME (WVAR (w, frame)), + && (f = XFRAME (w->frame), width = FRAME_INTERNAL_BORDER_WIDTH (f), width != 0) && (height = desired_row->visible_height, @@ -2718,7 +2718,7 @@ x_ins_del_lines (struct frame *f, int vpos, int n) static void x_scroll_run (struct window *w, struct run *run) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int x, y, width, height, from_y, to_y, bottom_y; HWND hwnd = FRAME_W32_WINDOW (f); HRGN expect_dirty; @@ -2972,7 +2972,7 @@ x_frame_rehighlight (struct w32_display_info *dpyinfo) : dpyinfo->w32_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) { - FRAME_FOCUS_FRAME (dpyinfo->w32_focus_frame) = Qnil; + FSET (dpyinfo->w32_focus_frame, focus_frame, Qnil); dpyinfo->x_highlight_frame = dpyinfo->w32_focus_frame; } } @@ -3612,6 +3612,7 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) SCROLLINFO si; struct scroll_bar *bar = XSCROLL_BAR (Fmake_vector (make_number (SCROLL_BAR_VEC_SIZE), Qnil)); + Lisp_Object barobj; BLOCK_INPUT; @@ -3644,7 +3645,8 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; - XSETVECTOR (FRAME_SCROLL_BARS (f), bar); + XSETVECTOR (barobj, bar); + FSET (f, scroll_bars, barobj); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); @@ -3668,7 +3670,7 @@ x_scroll_bar_remove (struct scroll_bar *bar) my_destroy_window (f, SCROLL_BAR_W32_WINDOW (bar)); /* Dissociate this scroll bar from its window. */ - WVAR (XWINDOW (bar->window), vertical_scroll_bar) = Qnil; + WSET (XWINDOW (bar->window), vertical_scroll_bar, Qnil); UNBLOCK_INPUT; } @@ -3681,7 +3683,8 @@ static void w32_set_vertical_scroll_bar (struct window *w, int portion, int whole, int position) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); + Lisp_Object barobj; struct scroll_bar *bar; int top, height, left, sb_left, width, sb_width; int window_y, window_height; @@ -3721,7 +3724,7 @@ w32_set_vertical_scroll_bar (struct window *w, || WINDOW_RIGHT_MARGIN_COLS (w) == 0)); /* Does the scroll bar exist yet? */ - if (NILP (WVAR (w, vertical_scroll_bar))) + if (NILP (w->vertical_scroll_bar)) { HDC hdc; BLOCK_INPUT; @@ -3743,7 +3746,7 @@ w32_set_vertical_scroll_bar (struct window *w, /* It may just need to be moved and resized. */ HWND hwnd; - bar = XSCROLL_BAR (WVAR (w, vertical_scroll_bar)); + bar = XSCROLL_BAR (w->vertical_scroll_bar); hwnd = SCROLL_BAR_W32_WINDOW (bar); /* If already correctly positioned, do nothing. */ @@ -3804,8 +3807,8 @@ w32_set_vertical_scroll_bar (struct window *w, bar->fringe_extended_p = fringe_extended_p ? Qt : Qnil; w32_set_scroll_bar_thumb (bar, portion, position, whole); - - XSETVECTOR (WVAR (w, vertical_scroll_bar), bar); + XSETVECTOR (barobj, bar); + WSET (w, vertical_scroll_bar, barobj); } @@ -3829,12 +3832,12 @@ w32_condemn_scroll_bars (FRAME_PTR frame) { Lisp_Object bar; bar = FRAME_SCROLL_BARS (frame); - FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next; + FSET (frame, scroll_bars, XSCROLL_BAR (bar)->next); XSCROLL_BAR (bar)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); XSCROLL_BAR (bar)->prev = Qnil; if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = bar; - FRAME_CONDEMNED_SCROLL_BARS (frame) = bar; + FSET (frame, condemned_scroll_bars, bar); } } @@ -3846,13 +3849,14 @@ static void w32_redeem_scroll_bar (struct window *window) { struct scroll_bar *bar; + Lisp_Object barobj; struct frame *f; /* We can't redeem this window's scroll bar if it doesn't have one. */ - if (NILP (WVAR (window, vertical_scroll_bar))) + if (NILP (window->vertical_scroll_bar)) abort (); - bar = XSCROLL_BAR (WVAR (window, vertical_scroll_bar)); + bar = XSCROLL_BAR (window->vertical_scroll_bar); /* Unlink it from the condemned list. */ f = XFRAME (WINDOW_FRAME (window)); @@ -3860,12 +3864,12 @@ w32_redeem_scroll_bar (struct window *window) { /* If the prev pointer is nil, it must be the first in one of the lists. */ - if (EQ (FRAME_SCROLL_BARS (f), WVAR (window, vertical_scroll_bar))) + if (EQ (FRAME_SCROLL_BARS (f), window->vertical_scroll_bar)) /* It's not condemned. Everything's fine. */ return; else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), - WVAR (window, vertical_scroll_bar))) - FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next; + window->vertical_scroll_bar)) + FSET (f, condemned_scroll_bars, bar->next); else /* If its prev pointer is nil, it must be at the front of one or the other! */ @@ -3879,7 +3883,8 @@ w32_redeem_scroll_bar (struct window *window) bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; - XSETVECTOR (FRAME_SCROLL_BARS (f), bar); + XSETVECTOR (barobj, bar); + FSET (f, scroll_bars, barobj); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); } @@ -3896,7 +3901,7 @@ w32_judge_scroll_bars (FRAME_PTR f) /* Clear out the condemned list now so we won't try to process any more events on the hapless scroll bars. */ - FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil; + FSET (f, condemned_scroll_bars, Qnil); for (; ! NILP (bar); bar = next) { @@ -4189,7 +4194,7 @@ w32_read_socket (struct terminal *terminal, int expected, /* We may get paint messages even though the client area is clipped - these are not expose events. */ DebPrint (("clipped frame %p (%s) got WM_PAINT - ignored\n", f, - SDATA (FVAR (f, name)))); + SDATA (f->name))); } else if (f->async_visible != 1) { @@ -4198,7 +4203,7 @@ w32_read_socket (struct terminal *terminal, int expected, f->async_iconified = 0; SET_FRAME_GARBAGED (f); DebPrint (("frame %p (%s) reexposed by WM_PAINT\n", f, - SDATA (FVAR (f, name)))); + SDATA (f->name))); /* WM_PAINT serves as MapNotify as well, so report visibility changes properly. */ @@ -4254,7 +4259,7 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (FVAR (f, tool_bar_window), hlinfo->mouse_face_window)) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -4279,7 +4284,7 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (FVAR (f, tool_bar_window), hlinfo->mouse_face_window)) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -4357,7 +4362,7 @@ w32_read_socket (struct terminal *terminal, int expected, if (f && !f->iconified) { if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) - && !EQ (FVAR (f, tool_bar_window), hlinfo->mouse_face_window)) + && !EQ (f->tool_bar_window, hlinfo->mouse_face_window)) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -4422,8 +4427,8 @@ w32_read_socket (struct terminal *terminal, int expected, create event iff we don't leave the selected frame. */ && (focus_follows_mouse - || (EQ (WVAR (XWINDOW (window), frame), - WVAR (XWINDOW (selected_window), frame))))) + || (EQ (XWINDOW (window)->frame, + XWINDOW (selected_window)->frame)))) { inev.kind = SELECT_WINDOW_EVENT; inev.frame_or_window = window; @@ -4481,8 +4486,8 @@ w32_read_socket (struct terminal *terminal, int expected, construct_mouse_click (&inev, &msg, f); /* Is this in the tool-bar? */ - if (WINDOWP (FVAR (f, tool_bar_window)) - && WINDOW_TOTAL_LINES (XWINDOW (FVAR (f, tool_bar_window)))) + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) { Lisp_Object window; int x = XFASTINT (inev.x); @@ -4490,7 +4495,7 @@ w32_read_socket (struct terminal *terminal, int expected, window = window_from_coordinates (f, x, y, 0, 1); - if (EQ (window, FVAR (f, tool_bar_window))) + if (EQ (window, f->tool_bar_window)) { w32_handle_tool_bar_click (f, &inev); tool_bar_p = 1; @@ -4935,7 +4940,7 @@ w32_read_socket (struct terminal *terminal, int expected, if (!FRAME_OBSCURED_P (f)) { DebPrint (("frame %p (%s) obscured\n", f, - SDATA (FVAR (f, name)))); + SDATA (f->name))); } } else @@ -4947,7 +4952,7 @@ w32_read_socket (struct terminal *terminal, int expected, { SET_FRAME_GARBAGED (f); DebPrint (("obscured frame %p (%s) found to be visible\n", f, - SDATA (FVAR (f, name)))); + SDATA (f->name))); /* Force a redisplay sooner or later. */ record_asynch_buffer_change (); @@ -5038,7 +5043,7 @@ static void x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text_cursor_kinds kind) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph *cursor_glyph; /* If cursor is out of bounds, don't draw garbage. This can happen @@ -5488,7 +5493,7 @@ x_set_offset (struct frame *f, register int xoff, register int yoff, /* Check if we need to resize the frame due to a fullscreen request. - If so needed, resize the frame. */ + If so needed, resize the frame. */ static void x_check_fullscreen (struct frame *f) { @@ -5508,7 +5513,7 @@ x_check_fullscreen (struct frame *f) SET_FRAME_GARBAGED (f); cancel_mouse_face (f); - /* Wait for the change of frame size to occur */ + /* Wait for the change of frame size to occur. */ f->want_fullscreen |= FULLSCREEN_WAIT; } } @@ -5595,7 +5600,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) SET_FRAME_GARBAGED (f); /* If cursor was outside the new size, mark it as off. */ - mark_window_cursors_off (XWINDOW (FVAR (f, root_window))); + mark_window_cursors_off (XWINDOW (f->root_window)); /* Clear out any recollection of where the mouse highlighting was, since it might be in a place that's outside the new frame size. @@ -6227,7 +6232,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) terminal like X does. */ terminal->kboard = xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - KVAR (terminal->kboard, Vwindow_system) = intern ("w32"); + KSET (terminal->kboard, Vwindow_system, intern ("w32")); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. diff --git a/src/w32term.h b/src/w32term.h index c0a958ba5e5..ccbf3c42c0e 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -429,7 +429,7 @@ struct scroll_bar { #define SCROLL_BAR_VEC_SIZE \ ((sizeof (struct scroll_bar) \ - sizeof (EMACS_INT) - sizeof (struct Lisp_Vector *)) \ - / sizeof (Lisp_Object)) + / word_size) /* Turning a lisp vector value into a pointer to a struct scroll_bar. */ #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) diff --git a/src/window.c b/src/window.c index 31327f23ef5..31711718a38 100644 --- a/src/window.c +++ b/src/window.c @@ -153,8 +153,6 @@ decode_any_window (register Lisp_Object window) CHECK_WINDOW (window); w = XWINDOW (window); - /* The following test throws up every time a tooltip frame is displayed. */ - /* CHECK_LIVE_FRAME (w->frame); */ return w; } @@ -180,7 +178,7 @@ DEFUN ("window-frame", Fwindow_frame, Swindow_frame, 1, 1, 0, If WINDOW is omitted or nil, it defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), frame); + return decode_any_window (window)->frame; } DEFUN ("frame-root-window", Fframe_root_window, Sframe_root_window, 0, 1, 0, @@ -193,13 +191,13 @@ With a window argument, return the root window of that window's frame. */) Lisp_Object window; if (NILP (frame_or_window)) - window = FVAR (SELECTED_FRAME (), root_window); + window = SELECTED_FRAME ()->root_window; else if (WINDOWP (frame_or_window)) - window = FVAR (XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window))), root_window); + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window; else { CHECK_LIVE_FRAME (frame_or_window); - window = FVAR (XFRAME (frame_or_window), root_window); + window = XFRAME (frame_or_window)->root_window; } return window; @@ -237,21 +235,21 @@ the first window of that frame. */) Lisp_Object window; if (NILP (frame_or_window)) - window = FVAR (SELECTED_FRAME (), root_window); + window = SELECTED_FRAME ()->root_window; else if (WINDOWP (frame_or_window)) - window = FVAR (XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window))), root_window); + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->root_window; else { CHECK_LIVE_FRAME (frame_or_window); - window = FVAR (XFRAME (frame_or_window), root_window); + window = XFRAME (frame_or_window)->root_window; } - while (NILP (WVAR (XWINDOW (window), buffer))) + while (NILP (XWINDOW (window)->buffer)) { - if (! NILP (WVAR (XWINDOW (window), hchild))) - window = WVAR (XWINDOW (window), hchild); - else if (! NILP (WVAR (XWINDOW (window), vchild))) - window = WVAR (XWINDOW (window), vchild); + if (! NILP (XWINDOW (window)->hchild)) + window = XWINDOW (window)->hchild; + else if (! NILP (XWINDOW (window)->vchild)) + window = XWINDOW (window)->vchild; else abort (); } @@ -271,14 +269,13 @@ the selected window of that frame. */) Lisp_Object window; if (NILP (frame_or_window)) - window = FVAR (SELECTED_FRAME (), selected_window); + window = SELECTED_FRAME ()->selected_window; else if (WINDOWP (frame_or_window)) - window = FVAR (XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window))), - selected_window); + window = XFRAME (WINDOW_FRAME (XWINDOW (frame_or_window)))->selected_window; else { CHECK_LIVE_FRAME (frame_or_window); - window = FVAR (XFRAME (frame_or_window), selected_window); + window = XFRAME (frame_or_window)->selected_window; } return window; @@ -306,7 +303,7 @@ Return WINDOW. */) if (EQ (frame, selected_frame)) return Fselect_window (window, norecord); else - return FVAR (XFRAME (frame), selected_window) = window; + return FSET (XFRAME (frame), selected_window, window); } DEFUN ("selected-window", Fselected_window, Sselected_window, 0, 0, 0, @@ -340,7 +337,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) if (NILP (norecord)) { w->use_time = ++window_select_count; - record_buffer (WVAR (w, buffer)); + record_buffer (w->buffer); } if (EQ (window, selected_window) && !inhibit_point_swap) @@ -349,7 +346,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) sf = SELECTED_FRAME (); if (XFRAME (WINDOW_FRAME (w)) != sf) { - FVAR (XFRAME (WINDOW_FRAME (w)), selected_window) = window; + FSET (XFRAME (WINDOW_FRAME (w)), selected_window, window); /* Use this rather than Fhandle_switch_frame so that FRAME_FOCUS_FRAME is moved appropriately as we move around in the state where a minibuffer in a separate @@ -360,7 +357,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) return window; } else - FVAR (sf, selected_window) = window; + FSET (sf, selected_window, window); /* Store the current buffer's actual point into the old selected window. It belongs to that window, @@ -368,17 +365,17 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) if (!inhibit_point_swap) { ow = XWINDOW (selected_window); - if (! NILP (WVAR (ow, buffer))) - set_marker_both (WVAR (ow, pointm), WVAR (ow, buffer), - BUF_PT (XBUFFER (WVAR (ow, buffer))), - BUF_PT_BYTE (XBUFFER (WVAR (ow, buffer)))); + if (! NILP (ow->buffer)) + set_marker_both (ow->pointm, ow->buffer, + BUF_PT (XBUFFER (ow->buffer)), + BUF_PT_BYTE (XBUFFER (ow->buffer))); } selected_window = window; - Fset_buffer (WVAR (w, buffer)); + Fset_buffer (w->buffer); - BVAR (XBUFFER (WVAR (w, buffer)), last_selected_window) = window; + BSET (XBUFFER (w->buffer), last_selected_window, window); /* Go to the point recorded in the window. This is important when the buffer is in more @@ -386,7 +383,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) redisplay_window has altered point after scrolling, because it makes the change only in the window. */ { - register ptrdiff_t new_point = marker_position (WVAR (w, pointm)); + register ptrdiff_t new_point = marker_position (w->pointm); if (new_point < BEGV) SET_PT (BEGV); else if (new_point > ZV) @@ -421,7 +418,7 @@ If WINDOW is omitted or nil, it defaults to the selected window. Return nil for an internal window or a deleted window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), buffer); + return decode_any_window (window)->buffer; } DEFUN ("window-parent", Fwindow_parent, Swindow_parent, 0, 1, 0, @@ -430,7 +427,7 @@ If WINDOW is omitted or nil, it defaults to the selected window. Return nil for a window with no parent (e.g. a root window). */) (Lisp_Object window) { - return WVAR (decode_any_window (window), parent); + return decode_any_window (window)->parent; } DEFUN ("window-top-child", Fwindow_top_child, Swindow_top_child, 1, 1, 0, @@ -441,7 +438,7 @@ horizontal combination. */) (Lisp_Object window) { CHECK_WINDOW (window); - return WVAR (decode_any_window (window), vchild); + return decode_any_window (window)->vchild; } DEFUN ("window-left-child", Fwindow_left_child, Swindow_left_child, 1, 1, 0, @@ -452,7 +449,7 @@ vertical combination. */) (Lisp_Object window) { CHECK_WINDOW (window); - return WVAR (decode_any_window (window), hchild); + return decode_any_window (window)->hchild; } DEFUN ("window-next-sibling", Fwindow_next_sibling, Swindow_next_sibling, 0, 1, 0, @@ -461,7 +458,7 @@ If WINDOW is omitted or nil, it defaults to the selected window. Return nil if WINDOW has no next sibling. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), next); + return decode_any_window (window)->next; } DEFUN ("window-prev-sibling", Fwindow_prev_sibling, Swindow_prev_sibling, 0, 1, 0, @@ -470,7 +467,7 @@ If WINDOW is omitted or nil, it defaults to the selected window. Return nil if WINDOW has no previous sibling. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), prev); + return decode_any_window (window)->prev; } DEFUN ("window-combination-limit", Fwindow_combination_limit, Swindow_combination_limit, 1, 1, 0, @@ -480,7 +477,7 @@ WINDOW's siblings. A return value of t means that child windows of WINDOW are never \(re-)combined with WINDOW's siblings. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), combination_limit); + return decode_any_window (window)->combination_limit; } DEFUN ("set-window-combination-limit", Fset_window_combination_limit, Sset_window_combination_limit, 2, 2, 0, @@ -491,9 +488,7 @@ never \(re-)combined with WINDOW's siblings. Other values are reserved for future use. */) (Lisp_Object window, Lisp_Object limit) { - register struct window *w = decode_any_window (window); - WVAR (w, combination_limit) = limit; - return WVAR (w, combination_limit); + return WSET (decode_any_window (window), combination_limit, limit); } DEFUN ("window-use-time", Fwindow_use_time, Swindow_use_time, 0, 1, 0, @@ -519,7 +514,7 @@ On a graphical display, this total height is reported as an integer multiple of the default character height. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), total_lines); + return decode_any_window (window)->total_lines; } DEFUN ("window-total-width", Fwindow_total_width, Swindow_total_width, 0, 1, 0, @@ -534,7 +529,7 @@ On a graphical display, this total width is reported as an integer multiple of the default character width. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), total_cols); + return decode_any_window (window)->total_cols; } DEFUN ("window-new-total", Fwindow_new_total, Swindow_new_total, 0, 1, 0, @@ -542,7 +537,7 @@ DEFUN ("window-new-total", Fwindow_new_total, Swindow_new_total, 0, 1, 0, If WINDOW is omitted or nil, it defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), new_total); + return decode_any_window (window)->new_total; } DEFUN ("window-normal-size", Fwindow_normal_size, Swindow_normal_size, 0, 2, 0, @@ -551,10 +546,9 @@ If WINDOW is omitted or nil, it defaults to the selected window. If HORIZONTAL is non-nil, return the normal width of WINDOW. */) (Lisp_Object window, Lisp_Object horizontal) { - if (NILP (horizontal)) - return WVAR (decode_any_window (window), normal_lines); - else - return WVAR (decode_any_window (window), normal_cols); + struct window *w = decode_any_window (window); + + return NILP (horizontal) ? w->normal_lines : w->normal_cols; } DEFUN ("window-new-normal", Fwindow_new_normal, Swindow_new_normal, 0, 1, 0, @@ -562,7 +556,7 @@ DEFUN ("window-new-normal", Fwindow_new_normal, Swindow_new_normal, 0, 1, 0, If WINDOW is omitted or nil, it defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), new_normal); + return decode_any_window (window)->new_normal; } DEFUN ("window-left-column", Fwindow_left_column, Swindow_left_column, 0, 1, 0, @@ -574,7 +568,7 @@ value is 0 if there is no window to the left of WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), left_col); + return decode_any_window (window)->left_col; } DEFUN ("window-top-line", Fwindow_top_line, Swindow_top_line, 0, 1, 0, @@ -586,7 +580,7 @@ there is no window above WINDOW. If WINDOW is omitted or nil, it defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_any_window (window), top_line); + return decode_any_window (window)->top_line; } /* Return the number of lines of W's body. Don't count any mode or @@ -595,7 +589,7 @@ If WINDOW is omitted or nil, it defaults to the selected window. */) static int window_body_lines (struct window *w) { - int height = XFASTINT (WVAR (w, total_lines)); + int height = XFASTINT (w->total_lines); if (!MINI_WINDOW_P (w)) { @@ -617,7 +611,7 @@ int window_body_cols (struct window *w) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - int width = XINT (WVAR (w, total_cols)); + int width = XINT (w->total_cols); if (WINDOW_HAS_VERTICAL_SCROLL_BAR (w)) /* Scroll bars occupy a few columns. */ @@ -692,7 +686,7 @@ set_window_hscroll (struct window *w, EMACS_INT hscroll) /* Prevent redisplay shortcuts when changing the hscroll. */ if (w->hscroll != new_hscroll) - XBUFFER (WVAR (w, buffer))->prevent_redisplay_optimizations_p = 1; + XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; w->hscroll = new_hscroll; return make_number (new_hscroll); @@ -721,7 +715,7 @@ WINDOW defaults to the selected window. See `set-window-redisplay-end-trigger' for more information. */) (Lisp_Object window) { - return WVAR (decode_window (window), redisplay_end_trigger); + return decode_window (window)->redisplay_end_trigger; } DEFUN ("set-window-redisplay-end-trigger", Fset_window_redisplay_end_trigger, @@ -734,11 +728,7 @@ with two arguments: WINDOW, and the end trigger value. Afterwards the end-trigger value is reset to nil. */) (register Lisp_Object window, Lisp_Object value) { - register struct window *w; - - w = decode_window (window); - WVAR (w, redisplay_end_trigger) = value; - return value; + return WSET (decode_window (window), redisplay_end_trigger, value); } DEFUN ("window-edges", Fwindow_edges, Swindow_edges, 0, 1, 0, @@ -755,6 +745,7 @@ just the text area, use `window-inside-edges'. */) (Lisp_Object window) { register struct window *w = decode_any_window (window); + CHECK_LIVE_FRAME (w->frame); return Fcons (make_number (WINDOW_LEFT_EDGE_COL (w)), Fcons (make_number (WINDOW_TOP_EDGE_LINE (w)), @@ -776,6 +767,7 @@ of just the text area, use `window-inside-pixel-edges'. */) (Lisp_Object window) { register struct window *w = decode_any_window (window); + CHECK_LIVE_FRAME (w->frame); return Fcons (make_number (WINDOW_LEFT_EDGE_X (w)), Fcons (make_number (WINDOW_TOP_EDGE_Y (w)), @@ -787,7 +779,7 @@ of just the text area, use `window-inside-pixel-edges'. */) static void calc_absolute_offset (struct window *w, int *add_x, int *add_y) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); *add_y = f->top_pos; #ifdef FRAME_MENUBAR_HEIGHT *add_y += FRAME_MENUBAR_HEIGHT (f); @@ -821,6 +813,8 @@ of just the text area, use `window-inside-absolute-pixel-edges'. */) { register struct window *w = decode_any_window (window); int add_x, add_y; + + CHECK_LIVE_FRAME (w->frame); calc_absolute_offset (w, &add_x, &add_y); return Fcons (make_number (WINDOW_LEFT_EDGE_X (w) + add_x), @@ -1097,7 +1091,7 @@ If they are in the windows's left or right marginal areas, `left-margin'\n\ CHECK_LIVE_WINDOW (window); w = XWINDOW (window); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); CHECK_CONS (coordinates); lx = Fcar (coordinates); ly = Fcdr (coordinates); @@ -1222,13 +1216,13 @@ window_from_coordinates (struct frame *f, int x, int y, bar exists. */ if (NILP (window) && tool_bar_p - && WINDOWP (FVAR (f, tool_bar_window)) - && WINDOW_TOTAL_LINES (XWINDOW (FVAR (f, tool_bar_window))) > 0 - && (coordinates_in_window (XWINDOW (FVAR (f, tool_bar_window)), x, y) + && WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0 + && (coordinates_in_window (XWINDOW (f->tool_bar_window), x, y) != ON_NOTHING)) { *part = ON_TEXT; - window = FVAR (f, tool_bar_window); + window = f->tool_bar_window; } return window; @@ -1277,9 +1271,9 @@ But that is hard to define. */) register struct window *w = decode_window (window); if (w == XWINDOW (selected_window) - && current_buffer == XBUFFER (WVAR (w, buffer))) + && current_buffer == XBUFFER (w->buffer)) return Fpoint (); - return Fmarker_position (WVAR (w, pointm)); + return Fmarker_position (w->pointm); } DEFUN ("window-start", Fwindow_start, Swindow_start, 0, 1, 0, @@ -1288,7 +1282,7 @@ WINDOW must be a live window and defaults to the selected one. This is updated by redisplay or by calling `set-window-start'. */) (Lisp_Object window) { - return Fmarker_position (WVAR (decode_window (window), start)); + return Fmarker_position (decode_window (window)->start); } /* This is text temporarily removed from the doc string below. @@ -1319,7 +1313,7 @@ if it isn't already recorded. */) Lisp_Object buf; struct buffer *b; - buf = WVAR (w, buffer); + buf = w->buffer; CHECK_BUFFER (buf); b = XBUFFER (buf); @@ -1328,12 +1322,12 @@ if it isn't already recorded. */) The user can compute it with vertical-motion if he wants to. It would be nicer to do it automatically, but that's so slow that it would probably bother people. */ - if (NILP (WVAR (w, window_end_valid))) + if (NILP (w->window_end_valid)) return Qnil; #endif if (! NILP (update) - && ! (! NILP (WVAR (w, window_end_valid)) + && ! (! NILP (w->window_end_valid) && w->last_modified >= BUF_MODIFF (b) && w->last_overlay_modified >= BUF_OVERLAY_MODIFF (b)) && !noninteractive) @@ -1356,12 +1350,12 @@ if it isn't already recorded. */) `-l' containing a call to `rmail' with subsequent other commands. At the end, W->start happened to be BEG, while rmail had already narrowed the buffer. */ - if (XMARKER (WVAR (w, start))->charpos < BEGV) + if (XMARKER (w->start)->charpos < BEGV) SET_TEXT_POS (startp, BEGV, BEGV_BYTE); - else if (XMARKER (WVAR (w, start))->charpos > ZV) + else if (XMARKER (w->start)->charpos > ZV) SET_TEXT_POS (startp, ZV, ZV_BYTE); else - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); itdata = bidi_shelve_cache (); start_display (&it, w, startp); @@ -1375,7 +1369,7 @@ if it isn't already recorded. */) set_buffer_internal (old_buffer); } else - XSETINT (value, BUF_Z (b) - XFASTINT (WVAR (w, window_end_pos))); + XSETINT (value, BUF_Z (b) - XFASTINT (w->window_end_pos)); return value; } @@ -1389,10 +1383,10 @@ Return POS. */) CHECK_NUMBER_COERCE_MARKER (pos); if (w == XWINDOW (selected_window) - && XBUFFER (WVAR (w, buffer)) == current_buffer) + && XBUFFER (w->buffer) == current_buffer) Fgoto_char (pos); else - set_marker_restricted (WVAR (w, pointm), pos, WVAR (w, buffer)); + set_marker_restricted (w->pointm, pos, w->buffer); /* We have to make sure that redisplay updates the window to show the new value of point. */ @@ -1412,7 +1406,7 @@ overriding motion of point in order to display at this exact start. */) register struct window *w = decode_window (window); CHECK_NUMBER_COERCE_MARKER (pos); - set_marker_restricted (WVAR (w, start), pos, WVAR (w, buffer)); + set_marker_restricted (w->start, pos, w->buffer); /* this is not right, but much easier than doing what is right. */ w->start_at_line_beg = 0; if (NILP (noforce)) @@ -1454,8 +1448,8 @@ display row, and VPOS is the row number (0-based) containing POS. */) int x, y; w = decode_window (window); - buf = XBUFFER (WVAR (w, buffer)); - SET_TEXT_POS_FROM_MARKER (top, WVAR (w, start)); + buf = XBUFFER (w->buffer); + SET_TEXT_POS_FROM_MARKER (top, w->start); if (EQ (pos, Qt)) posint = -1; @@ -1467,7 +1461,7 @@ display row, and VPOS is the row number (0-based) containing POS. */) else if (w == XWINDOW (selected_window)) posint = PT; else - posint = XMARKER (WVAR (w, pointm))->charpos; + posint = XMARKER (w->pointm)->charpos; /* If position is above window start or outside buffer boundaries, or if window start is out of range, position is not visible. */ @@ -1524,11 +1518,11 @@ Return nil if window display is not up-to-date. In that case, use if (noninteractive || w->pseudo_window_p) return Qnil; - CHECK_BUFFER (WVAR (w, buffer)); - b = XBUFFER (WVAR (w, buffer)); + CHECK_BUFFER (w->buffer); + b = XBUFFER (w->buffer); /* Fail if current matrix is not up-to-date. */ - if (NILP (WVAR (w, window_end_valid)) + if (NILP (w->window_end_valid) || current_buffer->clip_changed || current_buffer->prevent_redisplay_optimizations_p || w->last_modified < BUF_MODIFF (b) @@ -1621,7 +1615,7 @@ window, unless that window is "strongly" dedicated to its buffer, that is the value returned by `window-dedicated-p' is t. */) (Lisp_Object window) { - return WVAR (decode_window (window), dedicated); + return decode_window (window)->dedicated; } DEFUN ("set-window-dedicated-p", Fset_window_dedicated_p, @@ -1645,10 +1639,7 @@ buffer. If and when `set-window-buffer' displays another buffer in a window, it also makes sure that the window is no more dedicated. */) (Lisp_Object window, Lisp_Object flag) { - register struct window *w = decode_window (window); - - WVAR (w, dedicated) = flag; - return WVAR (w, dedicated); + return WSET (decode_window (window), dedicated, flag); } DEFUN ("window-prev-buffers", Fwindow_prev_buffers, Swindow_prev_buffers, @@ -1661,7 +1652,7 @@ where BUFFER is a buffer, WINDOW-START is the start position of the window for that buffer, and POS is a window-specific point value. */) (Lisp_Object window) { - return WVAR (decode_window (window), prev_buffers); + return decode_window (window)->prev_buffers; } DEFUN ("set-window-prev-buffers", Fset_window_prev_buffers, @@ -1674,7 +1665,7 @@ where BUFFER is a buffer, WINDOW-START is the start position of the window for that buffer, and POS is a window-specific point value. */) (Lisp_Object window, Lisp_Object prev_buffers) { - return WVAR (decode_window (window), prev_buffers) = prev_buffers; + return WSET (decode_window (window), prev_buffers, prev_buffers); } DEFUN ("window-next-buffers", Fwindow_next_buffers, Swindow_next_buffers, @@ -1683,7 +1674,7 @@ DEFUN ("window-next-buffers", Fwindow_next_buffers, Swindow_next_buffers, WINDOW must be a live window and defaults to the selected one. */) (Lisp_Object window) { - return WVAR (decode_window (window), next_buffers); + return decode_window (window)->next_buffers; } DEFUN ("set-window-next-buffers", Fset_window_next_buffers, @@ -1693,7 +1684,7 @@ WINDOW must be a live window and defaults to the selected one. NEXT-BUFFERS should be a list of buffers. */) (Lisp_Object window, Lisp_Object next_buffers) { - return WVAR (decode_window (window), next_buffers) = next_buffers; + return WSET (decode_window (window), next_buffers, next_buffers); } DEFUN ("window-parameters", Fwindow_parameters, Swindow_parameters, @@ -1703,7 +1694,7 @@ WINDOW defaults to the selected window. The return value is a list of elements of the form (PARAMETER . VALUE). */) (Lisp_Object window) { - return Fcopy_alist (WVAR (decode_any_window (window), window_parameters)); + return Fcopy_alist (decode_any_window (window)->window_parameters); } DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter, @@ -1714,8 +1705,7 @@ WINDOW defaults to the selected window. */) { Lisp_Object result; - result = Fassq (parameter, WVAR (decode_any_window (window), - window_parameters)); + result = Fassq (parameter, decode_any_window (window)->window_parameters); return CDR_SAFE (result); } @@ -1728,10 +1718,10 @@ WINDOW defaults to the selected window. Return VALUE. */) register struct window *w = decode_any_window (window); Lisp_Object old_alist_elt; - old_alist_elt = Fassq (parameter, WVAR (w, window_parameters)); + old_alist_elt = Fassq (parameter, w->window_parameters); if (NILP (old_alist_elt)) - WVAR (w, window_parameters) - = Fcons (Fcons (parameter, value), WVAR (w, window_parameters)); + WSET (w, window_parameters, + Fcons (Fcons (parameter, value), w->window_parameters)); else Fsetcdr (old_alist_elt, value); return value; @@ -1743,7 +1733,7 @@ DEFUN ("window-display-table", Fwindow_display_table, Swindow_display_table, WINDOW defaults to the selected window. */) (Lisp_Object window) { - return WVAR (decode_window (window), display_table); + return decode_window (window)->display_table; } /* Get the display table for use on window W. This is either W's @@ -1756,11 +1746,11 @@ window_display_table (struct window *w) { struct Lisp_Char_Table *dp = NULL; - if (DISP_TABLE_P (WVAR (w, display_table))) - dp = XCHAR_TABLE (WVAR (w, display_table)); - else if (BUFFERP (WVAR (w, buffer))) + if (DISP_TABLE_P (w->display_table)) + dp = XCHAR_TABLE (w->display_table); + else if (BUFFERP (w->buffer)) { - struct buffer *b = XBUFFER (WVAR (w, buffer)); + struct buffer *b = XBUFFER (w->buffer); if (DISP_TABLE_P (BVAR (b, display_table))) dp = XCHAR_TABLE (BVAR (b, display_table)); @@ -1775,11 +1765,7 @@ DEFUN ("set-window-display-table", Fset_window_display_table, Sset_window_displa doc: /* Set WINDOW's display-table to TABLE. */) (register Lisp_Object window, Lisp_Object table) { - register struct window *w; - - w = decode_window (window); - WVAR (w, display_table) = table; - return table; + return WSET (decode_window (window), display_table, table); } /* Record info on buffer window W is displaying @@ -1790,14 +1776,14 @@ unshow_buffer (register struct window *w) Lisp_Object buf; struct buffer *b; - buf = WVAR (w, buffer); + buf = w->buffer; b = XBUFFER (buf); - if (b != XMARKER (WVAR (w, pointm))->buffer) + if (b != XMARKER (w->pointm)->buffer) abort (); #if 0 if (w == XWINDOW (selected_window) - || ! EQ (buf, WVAR (XWINDOW (selected_window), buffer))) + || ! EQ (buf, XWINDOW (selected_window)->buffer)) /* Do this except when the selected window's buffer is being removed from some other window. */ #endif @@ -1808,27 +1794,27 @@ unshow_buffer (register struct window *w) selected window, while last_window_start reflects another window which was recently showing the same buffer. Some people might say that might be a good thing. Let's see. */ - b->last_window_start = marker_position (WVAR (w, start)); + b->last_window_start = marker_position (w->start); /* Point in the selected window's buffer is actually stored in that buffer, and the window's pointm isn't used. So don't clobber point in that buffer. */ - if (! EQ (buf, WVAR (XWINDOW (selected_window), buffer)) + if (! EQ (buf, XWINDOW (selected_window)->buffer) /* This line helps to fix Horsley's testbug.el bug. */ && !(WINDOWP (BVAR (b, last_selected_window)) && w != XWINDOW (BVAR (b, last_selected_window)) - && EQ (buf, WVAR (XWINDOW (BVAR (b, last_selected_window)), buffer)))) + && EQ (buf, XWINDOW (BVAR (b, last_selected_window))->buffer))) temp_set_point_both (b, clip_to_bounds (BUF_BEGV (b), - XMARKER (WVAR (w, pointm))->charpos, + XMARKER (w->pointm)->charpos, BUF_ZV (b)), clip_to_bounds (BUF_BEGV_BYTE (b), - marker_byte_position (WVAR (w, pointm)), + marker_byte_position (w->pointm), BUF_ZV_BYTE (b))); if (WINDOWP (BVAR (b, last_selected_window)) && w == XWINDOW (BVAR (b, last_selected_window))) - BVAR (b, last_selected_window) = Qnil; + BSET (b, last_selected_window, Qnil); } /* Put NEW into the window structure in place of OLD. SETFLAG zero @@ -1842,19 +1828,19 @@ replace_window (Lisp_Object old, Lisp_Object new, int setflag) /* If OLD is its frame's root window, then NEW is the new root window for that frame. */ - if (EQ (old, FRAME_ROOT_WINDOW (XFRAME (WVAR (o, frame))))) - FRAME_ROOT_WINDOW (XFRAME (WVAR (o, frame))) = new; + if (EQ (old, FRAME_ROOT_WINDOW (XFRAME (o->frame)))) + FSET (XFRAME (o->frame), root_window, new); - if (setflag) - { - WVAR (n, left_col) = WVAR (o, left_col); - WVAR (n, top_line) = WVAR (o, top_line); - WVAR (n, total_cols) = WVAR (o, total_cols); - WVAR (n, total_lines) = WVAR (o, total_lines); - WVAR (n, normal_cols) = WVAR (o, normal_cols); - WVAR (o, normal_cols) = make_float (1.0); - WVAR (n, normal_lines) = WVAR (o, normal_lines); - WVAR (o, normal_lines) = make_float (1.0); + if (setflag) + { + WSET (n, left_col, o->left_col); + WSET (n, top_line, o->top_line); + WSET (n, total_cols, o->total_cols); + WSET (n, total_lines, o->total_lines); + WSET (n, normal_cols, o->normal_cols); + WSET (o, normal_cols, make_float (1.0)); + WSET (n, normal_lines, o->normal_lines); + WSET (o, normal_lines, make_float (1.0)); n->desired_matrix = n->current_matrix = 0; n->vscroll = 0; memset (&n->cursor, 0, sizeof (n->cursor)); @@ -1864,27 +1850,30 @@ replace_window (Lisp_Object old, Lisp_Object new, int setflag) n->phys_cursor_width = -1; n->must_be_updated_p = 0; n->pseudo_window_p = 0; - XSETFASTINT (WVAR (n, window_end_vpos), 0); - XSETFASTINT (WVAR (n, window_end_pos), 0); - WVAR (n, window_end_valid) = Qnil; + WSET (n, window_end_vpos, make_number (0)); + WSET (n, window_end_pos, make_number (0)); + WSET (n, window_end_valid, Qnil); n->frozen_window_start_p = 0; } - WVAR (n, next) = tem = WVAR (o, next); + tem = o->next; + WSET (n, next, tem); if (!NILP (tem)) - WVAR (XWINDOW (tem), prev) = new; + WSET (XWINDOW (tem), prev, new); - WVAR (n, prev) = tem = WVAR (o, prev); + tem = o->prev; + WSET (n, prev, tem); if (!NILP (tem)) - WVAR (XWINDOW (tem), next) = new; + WSET (XWINDOW (tem), next, new); - WVAR (n, parent) = tem = WVAR (o, parent); + tem = o->parent; + WSET (n, parent, tem); if (!NILP (tem)) { - if (EQ (WVAR (XWINDOW (tem), vchild), old)) - WVAR (XWINDOW (tem), vchild) = new; - if (EQ (WVAR (XWINDOW (tem), hchild), old)) - WVAR (XWINDOW (tem), hchild) = new; + if (EQ (XWINDOW (tem)->vchild, old)) + WSET (XWINDOW (tem), vchild, new); + if (EQ (XWINDOW (tem)->hchild, old)) + WSET (XWINDOW (tem), hchild, new); } } @@ -1900,64 +1889,65 @@ recombine_windows (Lisp_Object window) int horflag; w = XWINDOW (window); - parent = WVAR (w, parent); - if (!NILP (parent) && NILP (WVAR (w, combination_limit))) + parent = w->parent; + if (!NILP (parent) && NILP (w->combination_limit)) { p = XWINDOW (parent); - if (((!NILP (WVAR (p, vchild)) && !NILP (WVAR (w, vchild))) - || (!NILP (WVAR (p, hchild)) && !NILP (WVAR (w, hchild))))) + if (((!NILP (p->vchild) && !NILP (w->vchild)) + || (!NILP (p->hchild) && !NILP (w->hchild)))) /* WINDOW and PARENT are both either a vertical or a horizontal combination. */ { - horflag = NILP (WVAR (w, vchild)); - child = horflag ? WVAR (w, hchild) : WVAR (w, vchild); + horflag = NILP (w->vchild); + child = horflag ? w->hchild : w->vchild; c = XWINDOW (child); /* Splice WINDOW's children into its parent's children and assign new normal sizes. */ - if (NILP (WVAR (w, prev))) + if (NILP (w->prev)) if (horflag) - WVAR (p, hchild) = child; + WSET (p, hchild, child); else - WVAR (p, vchild) = child; + WSET (p, vchild, child); else { - WVAR (c, prev) = WVAR (w, prev); - WVAR (XWINDOW (WVAR (w, prev)), next) = child; + WSET (c, prev, w->prev); + WSET (XWINDOW (w->prev), next, child); } while (c) { - WVAR (c, parent) = parent; + WSET (c, parent, parent); if (horflag) - WVAR (c, normal_cols) - = make_float (XFLOATINT (WVAR (c, total_cols)) - / XFLOATINT (WVAR (p, total_cols))); + WSET (c, normal_cols, + make_float (XFLOATINT (c->total_cols) + / XFLOATINT (p->total_cols))); else - WVAR (c, normal_lines) - = make_float (XFLOATINT (WVAR (c, total_lines)) - / XFLOATINT (WVAR (p, total_lines))); + WSET (c, normal_lines, + make_float (XFLOATINT (c->total_lines) + / XFLOATINT (p->total_lines))); - if (NILP (WVAR (c, next))) + if (NILP (c->next)) { - if (!NILP (WVAR (w, next))) + if (!NILP (w->next)) { - WVAR (c, next) = WVAR (w, next); - WVAR (XWINDOW (WVAR (c, next)), prev) = child; + WSET (c, next, w->next); + WSET (XWINDOW (c->next), prev, child); } c = 0; } else { - child = WVAR (c, next); + child = c->next; c = XWINDOW (child); } } /* WINDOW can be deleted now. */ - WVAR (w, vchild) = WVAR (w, hchild) = Qnil; + WSET (w, vchild, Qnil); + WSET (w, hchild, Qnil); } } } @@ -2040,10 +2030,10 @@ static int candidate_window_p (Lisp_Object window, Lisp_Object owindow, Lisp_Object minibuf, Lisp_Object all_frames) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int candidate_p = 1; - if (!BUFFERP (WVAR (w, buffer))) + if (!BUFFERP (w->buffer)) candidate_p = 0; else if (MINI_WINDOW_P (w) && (EQ (minibuf, Qlambda) @@ -2058,13 +2048,13 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, Lisp_Object minibuf else if (NILP (all_frames)) { eassert (WINDOWP (owindow)); - candidate_p = EQ (WVAR (w, frame), WVAR (XWINDOW (owindow), frame)); + candidate_p = EQ (w->frame, XWINDOW (owindow)->frame); } else if (EQ (all_frames, Qvisible)) { FRAME_SAMPLE_VISIBILITY (f); candidate_p = FRAME_VISIBLE_P (f) - && (FRAME_TERMINAL (XFRAME (WVAR (w, frame))) + && (FRAME_TERMINAL (XFRAME (w->frame)) == FRAME_TERMINAL (XFRAME (selected_frame))); } @@ -2083,15 +2073,15 @@ candidate_window_p (Lisp_Object window, Lisp_Object owindow, Lisp_Object minibuf && !f->output_data.x->has_been_visible) #endif ) - && (FRAME_TERMINAL (XFRAME (WVAR (w, frame))) + && (FRAME_TERMINAL (XFRAME (w->frame)) == FRAME_TERMINAL (XFRAME (selected_frame))); } else if (WINDOWP (all_frames)) candidate_p = (EQ (FRAME_MINIBUF_WINDOW (f), all_frames) - || EQ (WVAR (XWINDOW (all_frames), frame), WVAR (w, frame)) - || EQ (WVAR (XWINDOW (all_frames), frame), FRAME_FOCUS_FRAME (f))); + || EQ (XWINDOW (all_frames)->frame, w->frame) + || EQ (XWINDOW (all_frames)->frame, FRAME_FOCUS_FRAME (f))); else if (FRAMEP (all_frames)) - candidate_p = EQ (all_frames, WVAR (w, frame)); + candidate_p = EQ (all_frames, w->frame); return candidate_p; } @@ -2124,7 +2114,7 @@ decode_next_window_args (Lisp_Object *window, Lisp_Object *minibuf, Lisp_Object if (NILP (*all_frames)) *all_frames = (!EQ (*minibuf, Qlambda) - ? FRAME_MINIBUF_WINDOW (XFRAME (WVAR (XWINDOW (*window), frame))) + ? FRAME_MINIBUF_WINDOW (XFRAME (XWINDOW (*window)->frame)) : Qnil); else if (EQ (*all_frames, Qvisible)) ; @@ -2150,7 +2140,7 @@ next_window (Lisp_Object window, Lisp_Object minibuf, Lisp_Object all_frames, in /* If ALL_FRAMES is a frame, and WINDOW isn't on that frame, just return the first window on the frame. */ if (FRAMEP (all_frames) - && !EQ (all_frames, WVAR (XWINDOW (window), frame))) + && !EQ (all_frames, XWINDOW (window)->frame)) return Fframe_first_window (all_frames); if (next_p) @@ -2325,12 +2315,12 @@ MINIBUF neither nil nor t means never include the minibuffer window. */) (Lisp_Object frame, Lisp_Object minibuf, Lisp_Object window) { if (NILP (window)) - window = FRAMEP (frame) ? FVAR (XFRAME (frame), selected_window) : selected_window; + window = FRAMEP (frame) ? XFRAME (frame)->selected_window : selected_window; CHECK_WINDOW (window); if (NILP (frame)) frame = selected_frame; - if (!EQ (frame, WVAR (XWINDOW (window), frame))) + if (!EQ (frame, XWINDOW (window)->frame)) error ("Window is on a different frame"); return window_list_1 (window, minibuf, frame); @@ -2451,7 +2441,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame switch (type) { case GET_BUFFER_WINDOW: - if (EQ (WVAR (w, buffer), obj) + if (EQ (w->buffer, obj) /* Don't find any minibuffer window except the one that is currently in use. */ && (MINI_WINDOW_P (w) ? EQ (window, minibuf_window) : 1)) @@ -2459,7 +2449,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame if (EQ (window, selected_window)) /* Preferably return the selected window. */ RETURN_UNGCPRO (window); - else if (EQ (WVAR (XWINDOW (window), frame), selected_frame) + else if (EQ (XWINDOW (window)->frame, selected_frame) && !frame_best_window_flag) /* Prefer windows on the current frame (but don't choose another one if we have one already). */ @@ -2475,25 +2465,25 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame case REPLACE_BUFFER_IN_WINDOWS_SAFELY: /* We could simply check whether the buffer shown by window is live, and show another buffer in case it isn't. */ - if (EQ (WVAR (w, buffer), obj)) + if (EQ (w->buffer, obj)) { /* Undedicate WINDOW. */ - WVAR (w, dedicated) = Qnil; + WSET (w, dedicated, Qnil); /* Make WINDOW show the buffer returned by other_buffer_safely, don't run any hooks. */ set_window_buffer - (window, other_buffer_safely (WVAR (w, buffer)), 0, 0); + (window, other_buffer_safely (w->buffer), 0, 0); /* If WINDOW is the selected window, make its buffer current. But do so only if the window shows the current buffer (Bug#6454). */ if (EQ (window, selected_window) - && XBUFFER (WVAR (w, buffer)) == current_buffer) - Fset_buffer (WVAR (w, buffer)); + && XBUFFER (w->buffer) == current_buffer) + Fset_buffer (w->buffer); } break; case REDISPLAY_BUFFER_WINDOWS: - if (EQ (WVAR (w, buffer), obj)) + if (EQ (w->buffer, obj)) { mark_window_display_accurate (window, 0); w->update_mode_line = 1; @@ -2505,8 +2495,8 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame /* Check for a window that has a killed buffer. */ case CHECK_ALL_WINDOWS: - if (! NILP (WVAR (w, buffer)) - && NILP (BVAR (XBUFFER (WVAR (w, buffer)), name))) + if (! NILP (w->buffer) + && NILP (BVAR (XBUFFER (w->buffer), name))) abort (); break; @@ -2592,8 +2582,9 @@ window-start value is reasonable when this function is called. */) int top IF_LINT (= 0), new_top, resize_failed; w = decode_any_window (window); + CHECK_LIVE_FRAME (w->frame); XSETWINDOW (window, w); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); if (NILP (root)) /* ROOT is the frame's root window. */ @@ -2605,12 +2596,13 @@ window-start value is reasonable when this function is called. */) /* ROOT must be an ancestor of WINDOW. */ { r = decode_any_window (root); - pwindow = WVAR (XWINDOW (window), parent); + CHECK_LIVE_FRAME (r->frame); + pwindow = XWINDOW (window)->parent; while (!NILP (pwindow)) if (EQ (pwindow, root)) break; else - pwindow = WVAR (XWINDOW (pwindow), parent); + pwindow = XWINDOW (pwindow)->parent; if (!EQ (pwindow, root)) error ("Specified root is not an ancestor of specified window"); } @@ -2624,18 +2616,18 @@ window-start value is reasonable when this function is called. */) else if (MINI_WINDOW_P (w)) /* && top > 0) */ error ("Can't expand minibuffer to full frame"); - if (!NILP (WVAR (w, buffer))) + if (!NILP (w->buffer)) { - startpos = marker_position (WVAR (w, start)); + startpos = marker_position (w->start); top = WINDOW_TOP_EDGE_LINE (w) - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w))); /* Make sure WINDOW is the frame's selected window. */ if (!EQ (window, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, WVAR (w, frame))) + if (EQ (selected_frame, w->frame)) Fselect_window (window, Qnil); else - FRAME_SELECTED_WINDOW (f) = window; + FSET (f, selected_window, window); } } else @@ -2649,7 +2641,7 @@ window-start value is reasonable when this function is called. */) { pwindow = swindow; while (!NILP (pwindow) && !EQ (window, pwindow)) - pwindow = WVAR (XWINDOW (pwindow), parent); + pwindow = XWINDOW (pwindow)->parent; if (EQ (window, pwindow)) /* If WINDOW is an ancestor of SWINDOW, then SWINDOW is ok @@ -2662,10 +2654,10 @@ window-start value is reasonable when this function is called. */) if (!EQ (swindow, FRAME_SELECTED_WINDOW (f))) { - if (EQ (selected_frame, WVAR (w, frame))) + if (EQ (selected_frame, w->frame)) Fselect_window (swindow, Qnil); else - FRAME_SELECTED_WINDOW (f) = swindow; + FSET (f, selected_window, swindow); } } @@ -2695,12 +2687,12 @@ window-start value is reasonable when this function is called. */) FRAME_WINDOW_SIZES_CHANGED (f) = 1; resize_failed = 0; - if (NILP (WVAR (w, buffer))) + if (NILP (w->buffer)) { /* Resize child windows vertically. */ - XSETINT (delta, XINT (WVAR (r, total_lines)) - - XINT (WVAR (w, total_lines))); - WVAR (w, top_line) = WVAR (r, top_line); + XSETINT (delta, XINT (r->total_lines) + - XINT (w->total_lines)); + WSET (w, top_line, r->top_line); resize_root_window (window, delta, Qnil, Qnil); if (window_resize_check (w, 0)) window_resize_apply (w, 0); @@ -2716,10 +2708,10 @@ window-start value is reasonable when this function is called. */) /* Resize child windows horizontally. */ if (!resize_failed) { - WVAR (w, left_col) = WVAR (r, left_col); - XSETINT (delta, XINT (WVAR (r, total_cols)) - - XINT (WVAR (w, total_cols))); - WVAR (w, left_col) = WVAR (r, left_col); + WSET (w, left_col, r->left_col); + XSETINT (delta, XINT (r->total_cols) + - XINT (w->total_cols)); + WSET (w, left_col, r->left_col); resize_root_window (window, delta, Qt, Qnil); if (window_resize_check (w, 1)) window_resize_apply (w, 1); @@ -2742,43 +2734,43 @@ window-start value is reasonable when this function is called. */) } /* Cleanly unlink WINDOW from window-tree. */ - if (!NILP (WVAR (w, prev))) + if (!NILP (w->prev)) /* Get SIBLING above (on the left of) WINDOW. */ { - sibling = WVAR (w, prev); + sibling = w->prev; s = XWINDOW (sibling); - WVAR (s, next) = WVAR (w, next); - if (!NILP (WVAR (s, next))) - WVAR (XWINDOW (WVAR (s, next)), prev) = sibling; + WSET (s, next, w->next); + if (!NILP (s->next)) + WSET (XWINDOW (s->next), prev, sibling); } else /* Get SIBLING below (on the right of) WINDOW. */ { - sibling = WVAR (w, next); + sibling = w->next; s = XWINDOW (sibling); - WVAR (s, prev) = Qnil; - if (!NILP (WVAR (XWINDOW (WVAR (w, parent)), vchild))) - WVAR (XWINDOW (WVAR (w, parent)), vchild) = sibling; + WSET (s, prev, Qnil); + if (!NILP (XWINDOW (w->parent)->vchild)) + WSET (XWINDOW (w->parent), vchild, sibling); else - WVAR (XWINDOW (WVAR (w, parent)), hchild) = sibling; + WSET (XWINDOW (w->parent), hchild, sibling); } /* Delete ROOT and all child windows of ROOT. */ - if (!NILP (WVAR (r, vchild))) + if (!NILP (r->vchild)) { - delete_all_child_windows (WVAR (r, vchild)); - WVAR (r, vchild) = Qnil; + delete_all_child_windows (r->vchild); + WSET (r, vchild, Qnil); } - else if (!NILP (WVAR (r, hchild))) + else if (!NILP (r->hchild)) { - delete_all_child_windows (WVAR (r, hchild)); - WVAR (r, hchild) = Qnil; + delete_all_child_windows (r->hchild); + WSET (r, hchild, Qnil); } replace_window (root, window, 1); /* This must become SWINDOW anyway ....... */ - if (!NILP (WVAR (w, buffer)) && !resize_failed) + if (!NILP (w->buffer) && !resize_failed) { /* Try to minimize scrolling, by setting the window start to the point will cause the text at the old window start to be at the @@ -2787,19 +2779,19 @@ window-start value is reasonable when this function is called. */) when the display is not current, due to typeahead). */ new_top = WINDOW_TOP_EDGE_LINE (w) - FRAME_TOP_MARGIN (XFRAME (WINDOW_FRAME (w))); if (new_top != top - && startpos >= BUF_BEGV (XBUFFER (WVAR (w, buffer))) - && startpos <= BUF_ZV (XBUFFER (WVAR (w, buffer)))) + && startpos >= BUF_BEGV (XBUFFER (w->buffer)) + && startpos <= BUF_ZV (XBUFFER (w->buffer))) { struct position pos; struct buffer *obuf = current_buffer; - Fset_buffer (WVAR (w, buffer)); + Fset_buffer (w->buffer); /* This computation used to temporarily move point, but that can have unwanted side effects due to text properties. */ pos = *vmotion (startpos, -top, w); - set_marker_both (WVAR (w, start), WVAR (w, buffer), pos.bufpos, pos.bytepos); - WVAR (w, window_end_valid) = Qnil; + set_marker_both (w->start, w->buffer, pos.bufpos, pos.bytepos); + WSET (w, window_end_valid, Qnil); w->start_at_line_beg = (pos.bytepos == BEGV_BYTE || FETCH_BYTE (pos.bytepos - 1) == '\n'); /* We need to do this, so that the window-scroll-functions @@ -2889,13 +2881,15 @@ adjust_window_margins (struct window *w) if (WINDOW_RIGHT_MARGIN_COLS (w) > 0) { if (WINDOW_LEFT_MARGIN_COLS (w) > 0) - WVAR (w, left_margin_cols) = WVAR (w, right_margin_cols) - = make_number (margin_cols/2); + { + WSET (w, left_margin_cols, make_number (margin_cols / 2)); + WSET (w, right_margin_cols, make_number (margin_cols / 2)); + } else - WVAR (w, right_margin_cols) = make_number (margin_cols); + WSET (w, right_margin_cols, make_number (margin_cols)); } else - WVAR (w, left_margin_cols) = make_number (margin_cols); + WSET (w, left_margin_cols, make_number (margin_cols)); return 1; } @@ -2993,25 +2987,25 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int struct window *w = XWINDOW (window); struct buffer *b = XBUFFER (buffer); ptrdiff_t count = SPECPDL_INDEX (); - int samebuf = EQ (buffer, WVAR (w, buffer)); + int samebuf = EQ (buffer, w->buffer); - WVAR (w, buffer) = buffer; + WSET (w, buffer, buffer); if (EQ (window, selected_window)) - BVAR (b, last_selected_window) = window; + BSET (b, last_selected_window, window); /* Let redisplay errors through. */ b->display_error_modiff = 0; /* Update time stamps of buffer display. */ if (INTEGERP (BVAR (b, display_count))) - XSETINT (BVAR (b, display_count), XINT (BVAR (b, display_count)) + 1); - BVAR (b, display_time) = Fcurrent_time (); + BSET (b, display_count, make_number (XINT (BVAR (b, display_count)) + 1)); + BSET (b, display_time, Fcurrent_time ()); - XSETFASTINT (WVAR (w, window_end_pos), 0); - XSETFASTINT (WVAR (w, window_end_vpos), 0); + WSET (w, window_end_pos, make_number (0)); + WSET (w, window_end_vpos, make_number (0)); memset (&w->last_cursor, 0, sizeof w->last_cursor); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); if (!(keep_margins_p && samebuf)) { /* If we're not actually changing the buffer, don't reset hscroll and vscroll. This case happens for example when called from @@ -3023,8 +3017,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int whenever we resize the frame. */ w->hscroll = w->min_hscroll = 0; w->vscroll = 0; - set_marker_both (WVAR (w, pointm), buffer, BUF_PT (b), BUF_PT_BYTE (b)); - set_marker_restricted (WVAR (w, start), + set_marker_both (w->pointm, buffer, BUF_PT (b), BUF_PT_BYTE (b)); + set_marker_restricted (w->start, make_number (b->last_window_start), buffer); w->start_at_line_beg = 0; @@ -3045,7 +3039,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int Fset_buffer (buffer); } - XMARKER (WVAR (w, pointm))->insertion_type = !NILP (Vwindow_point_insertion_type); + XMARKER (w->pointm)->insertion_type = !NILP (Vwindow_point_insertion_type); if (!keep_margins_p) { @@ -3053,10 +3047,11 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int /* This may call adjust_window_margins three times, so temporarily disable window margins. */ - Lisp_Object save_left = WVAR (w, left_margin_cols); - Lisp_Object save_right = WVAR (w, right_margin_cols); + Lisp_Object save_left = w->left_margin_cols; + Lisp_Object save_right = w->right_margin_cols; - WVAR (w, left_margin_cols) = WVAR (w, right_margin_cols) = Qnil; + WSET (w, left_margin_cols, Qnil); + WSET (w, right_margin_cols, Qnil); Fset_window_fringes (window, BVAR (b, left_fringe_width), BVAR (b, right_fringe_width), @@ -3066,8 +3061,8 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int BVAR (b, scroll_bar_width), BVAR (b, vertical_scroll_bar_type), Qnil); - WVAR (w, left_margin_cols) = save_left; - WVAR (w, right_margin_cols) = save_right; + WSET (w, left_margin_cols, save_left); + WSET (w, right_margin_cols, save_right); Fset_window_margins (window, BVAR (b, left_margin_cols), BVAR (b, right_margin_cols)); @@ -3077,7 +3072,7 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int { if (! NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, window, - Fmarker_position (WVAR (w, start))); + Fmarker_position (w->start)); run_window_configuration_change_hook (XFRAME (WINDOW_FRAME (w))); } @@ -3111,7 +3106,7 @@ This function runs `window-scroll-functions' before running if (NILP (BVAR (XBUFFER (buffer), name))) error ("Attempt to display deleted buffer"); - tem = WVAR (w, buffer); + tem = w->buffer; if (NILP (tem)) error ("Window is deleted"); else if (!EQ (tem, Qt)) @@ -3119,14 +3114,14 @@ This function runs `window-scroll-functions' before running { if (!EQ (tem, buffer)) { - if (EQ (WVAR (w, dedicated), Qt)) + if (EQ (w->dedicated, Qt)) /* WINDOW is strongly dedicated to its buffer, signal an error. */ error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name))); else /* WINDOW is weakly dedicated to its buffer, reset dedication. */ - WVAR (w, dedicated) = Qnil; + WSET (w, dedicated, Qnil); call1 (Qrecord_window_buffer, window); } @@ -3165,8 +3160,8 @@ displaying that buffer. */) struct window *w = XWINDOW (object); mark_window_display_accurate (object, 0); w->update_mode_line = 1; - if (BUFFERP (WVAR (w, buffer))) - XBUFFER (WVAR (w, buffer))->prevent_redisplay_optimizations_p = 1; + if (BUFFERP (w->buffer)) + XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; ++update_mode_lines; return Qt; } @@ -3196,7 +3191,7 @@ temp_output_buffer_show (register Lisp_Object buf) register Lisp_Object window; register struct window *w; - BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory); + BSET (XBUFFER (buf), directory, BVAR (current_buffer, directory)); Fset_buffer (buf); BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; @@ -3211,14 +3206,14 @@ temp_output_buffer_show (register Lisp_Object buf) { window = display_buffer (buf, Qnil, Qnil); - if (!EQ (WVAR (XWINDOW (window), frame), selected_frame)) + if (!EQ (XWINDOW (window)->frame, selected_frame)) Fmake_frame_visible (WINDOW_FRAME (XWINDOW (window))); Vminibuf_scroll_window = window; w = XWINDOW (window); w->hscroll = 0; w->min_hscroll = 0; - set_marker_restricted_both (WVAR (w, start), buf, BEG, BEG); - set_marker_restricted_both (WVAR (w, pointm), buf, BEG, BEG); + set_marker_restricted_both (w->start, buf, BEG, BEG); + set_marker_restricted_both (w->pointm, buf, BEG, BEG); /* Run temp-buffer-show-hook, with the chosen window selected and its buffer current. */ @@ -3235,7 +3230,7 @@ temp_output_buffer_show (register Lisp_Object buf) record_unwind_protect (Fset_buffer, prev_buffer); record_unwind_protect (select_window_norecord, prev_window); Fselect_window (window, Qt); - Fset_buffer (WVAR (w, buffer)); + Fset_buffer (w->buffer); Frun_hooks (1, &Qtemp_buffer_show_hook); unbind_to (count, Qnil); } @@ -3265,24 +3260,24 @@ make_parent_window (Lisp_Object window, int horflag) p = allocate_window (); memcpy ((char *) p + sizeof (struct vectorlike_header), (char *) o + sizeof (struct vectorlike_header), - sizeof (Lisp_Object) * VECSIZE (struct window)); + word_size * VECSIZE (struct window)); XSETWINDOW (parent, p); p->sequence_number = ++sequence_number; replace_window (window, parent, 1); - WVAR (o, next) = Qnil; - WVAR (o, prev) = Qnil; - WVAR (o, parent) = parent; + WSET (o, next, Qnil); + WSET (o, prev, Qnil); + WSET (o, parent, parent); - WVAR (p, hchild) = horflag ? window : Qnil; - WVAR (p, vchild) = horflag ? Qnil : window; - WVAR (p, start) = Qnil; - WVAR (p, pointm) = Qnil; - WVAR (p, buffer) = Qnil; - WVAR (p, combination_limit) = Qnil; - WVAR (p, window_parameters) = Qnil; + WSET (p, hchild, horflag ? window : Qnil); + WSET (p, vchild, horflag ? Qnil : window); + WSET (p, start, Qnil); + WSET (p, pointm, Qnil); + WSET (p, buffer, Qnil); + WSET (p, combination_limit, Qnil); + WSET (p, window_parameters, Qnil); } /* Make new window from scratch. */ @@ -3295,19 +3290,19 @@ make_window (void) w = allocate_window (); /* Initialize Lisp data. Note that allocate_window initializes all Lisp data to nil, so do it only for slots which should not be nil. */ - XSETFASTINT (WVAR (w, left_col), 0); - XSETFASTINT (WVAR (w, top_line), 0); - XSETFASTINT (WVAR (w, total_lines), 0); - XSETFASTINT (WVAR (w, total_cols), 0); - WVAR (w, normal_lines) = make_float (1.0); - WVAR (w, normal_cols) = make_float (1.0); - XSETFASTINT (WVAR (w, new_total), 0); - XSETFASTINT (WVAR (w, new_normal), 0); - WVAR (w, start) = Fmake_marker (); - WVAR (w, pointm) = Fmake_marker (); - WVAR (w, vertical_scroll_bar_type) = Qt; - XSETFASTINT (WVAR (w, window_end_pos), 0); - XSETFASTINT (WVAR (w, window_end_vpos), 0); + WSET (w, left_col, make_number (0)); + WSET (w, top_line, make_number (0)); + WSET (w, total_lines, make_number (0)); + WSET (w, total_cols, make_number (0)); + WSET (w, normal_lines, make_float (1.0)); + WSET (w, normal_cols, make_float (1.0)); + WSET (w, new_total, make_number (0)); + WSET (w, new_normal, make_number (0)); + WSET (w, start, Fmake_marker ()); + WSET (w, pointm, Fmake_marker ()); + WSET (w, vertical_scroll_bar_type, Qt); + WSET (w, window_end_pos, make_number (0)); + WSET (w, window_end_vpos, make_number (0)); /* Initialize non-Lisp data. Note that allocate_window zeroes out all non-Lisp data, so do it only for slots which should not be zero. */ @@ -3337,11 +3332,11 @@ Note: This function does not operate on any child windows of WINDOW. */) CHECK_NUMBER (size); if (NILP (add)) - XSETINT (WVAR (w, new_total), XINT (size)); + WSET (w, new_total, size); else - XSETINT (WVAR (w, new_total), XINT (WVAR (w, new_total)) + XINT (size)); + WSET (w, new_total, make_number (XINT (w->new_total) + XINT (size))); - return WVAR (w, new_total); + return w->new_total; } DEFUN ("set-window-new-normal", Fset_window_new_normal, Sset_window_new_normal, 1, 2, 0, @@ -3351,10 +3346,7 @@ Return SIZE. Note: This function does not operate on any child windows of WINDOW. */) (Lisp_Object window, Lisp_Object size) { - struct window *w = decode_any_window (window); - - WVAR (w, new_normal) = size; - return WVAR (w, new_normal); + return WSET (decode_any_window (window), new_normal, size); } /* Return 1 if setting w->total_lines (w->total_cols if HORFLAG is @@ -3369,19 +3361,19 @@ window_resize_check (struct window *w, int horflag) { struct window *c; - if (!NILP (WVAR (w, vchild))) + if (!NILP (w->vchild)) /* W is a vertical combination. */ { - c = XWINDOW (WVAR (w, vchild)); + c = XWINDOW (w->vchild); if (horflag) /* All child windows of W must have the same width as W. */ { while (c) { - if ((XINT (WVAR (c, new_total)) != XINT (WVAR (w, new_total))) + if ((XINT (c->new_total) != XINT (w->new_total)) || !window_resize_check (c, horflag)) return 0; - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } return 1; } @@ -3394,16 +3386,16 @@ window_resize_check (struct window *w, int horflag) { if (!window_resize_check (c, horflag)) return 0; - sum_of_sizes = sum_of_sizes + XINT (WVAR (c, new_total)); - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + sum_of_sizes = sum_of_sizes + XINT (c->new_total); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } - return (sum_of_sizes == XINT (WVAR (w, new_total))); + return (sum_of_sizes == XINT (w->new_total)); } } - else if (!NILP (WVAR (w, hchild))) + else if (!NILP (w->hchild)) /* W is a horizontal combination. */ { - c = XWINDOW (WVAR (w, hchild)); + c = XWINDOW (w->hchild); if (horflag) /* The sum of the widths of the child windows of W must equal W's width. */ @@ -3413,20 +3405,20 @@ window_resize_check (struct window *w, int horflag) { if (!window_resize_check (c, horflag)) return 0; - sum_of_sizes = sum_of_sizes + XINT (WVAR (c, new_total)); - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + sum_of_sizes = sum_of_sizes + XINT (c->new_total); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } - return (sum_of_sizes == XINT (WVAR (w, new_total))); + return (sum_of_sizes == XINT (w->new_total)); } else /* All child windows of W must have the same height as W. */ { while (c) { - if ((XINT (WVAR (c, new_total)) != XINT (WVAR (w, new_total))) + if ((XINT (c->new_total) != XINT (w->new_total)) || !window_resize_check (c, horflag)) return 0; - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } return 1; } @@ -3435,7 +3427,7 @@ window_resize_check (struct window *w, int horflag) /* A leaf window. Make sure it's not too small. The following hardcodes the values of `window-safe-min-width' (2) and `window-safe-min-height' (1) which are defined in window.el. */ - return XINT (WVAR (w, new_total)) >= (horflag ? 2 : 1); + return XINT (w->new_total) >= (horflag ? 2 : 1); } /* Set w->total_lines (w->total_cols if HORIZONTAL is non-zero) to @@ -3455,51 +3447,51 @@ window_resize_apply (struct window *w, int horflag) parent window has been set *before*. */ if (horflag) { - WVAR (w, total_cols) = WVAR (w, new_total); - if (NUMBERP (WVAR (w, new_normal))) - WVAR (w, normal_cols) = WVAR (w, new_normal); + WSET (w, total_cols, w->new_total); + if (NUMBERP (w->new_normal)) + WSET (w, normal_cols, w->new_normal); - pos = XINT (WVAR (w, left_col)); + pos = XINT (w->left_col); } else { - WVAR (w, total_lines) = WVAR (w, new_total); - if (NUMBERP (WVAR (w, new_normal))) - WVAR (w, normal_lines) = WVAR (w, new_normal); + WSET (w, total_lines, w->new_total); + if (NUMBERP (w->new_normal)) + WSET (w, normal_lines, w->new_normal); - pos = XINT (WVAR (w, top_line)); + pos = XINT (w->top_line); } - if (!NILP (WVAR (w, vchild))) + if (!NILP (w->vchild)) /* W is a vertical combination. */ { - c = XWINDOW (WVAR (w, vchild)); + c = XWINDOW (w->vchild); while (c) { if (horflag) - XSETFASTINT (WVAR (c, left_col), pos); + WSET (c, left_col, make_number (pos)); else - XSETFASTINT (WVAR (c, top_line), pos); + WSET (c, top_line, make_number (pos)); window_resize_apply (c, horflag); if (!horflag) - pos = pos + XINT (WVAR (c, total_lines)); - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + pos = pos + XINT (c->total_lines); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } } - else if (!NILP (WVAR (w, hchild))) + else if (!NILP (w->hchild)) /* W is a horizontal combination. */ { - c = XWINDOW (WVAR (w, hchild)); + c = XWINDOW (w->hchild); while (c) { if (horflag) - XSETFASTINT (WVAR (c, left_col), pos); + WSET (c, left_col, make_number (pos)); else - XSETFASTINT (WVAR (c, top_line), pos); + WSET (c, top_line, make_number (pos)); window_resize_apply (c, horflag); if (horflag) - pos = pos + XINT (WVAR (c, total_cols)); - c = NILP (WVAR (c, next)) ? 0 : XWINDOW (WVAR (c, next)); + pos = pos + XINT (c->total_cols); + c = NILP (c->next) ? 0 : XWINDOW (c->next); } } @@ -3535,8 +3527,8 @@ be applied on the Elisp level. */) r = XWINDOW (FRAME_ROOT_WINDOW (f)); if (!window_resize_check (r, horflag) - || ! EQ (WVAR (r, new_total), - (horflag ? WVAR (r, total_cols) : WVAR (r, total_lines)))) + || ! EQ (r->new_total, + (horflag ? r->total_cols : r->total_lines))) return Qnil; BLOCK_INPUT; @@ -3564,9 +3556,9 @@ be applied on the Elisp level. */) void resize_frame_windows (struct frame *f, int size, int horflag) { - Lisp_Object root = FVAR (f, root_window); + Lisp_Object root = f->root_window; struct window *r = XWINDOW (root); - Lisp_Object mini = FVAR (f, minibuffer_window); + Lisp_Object mini = f->minibuffer_window; struct window *m; /* new_size is the new size of the frame's root window. */ int new_size = (horflag @@ -3576,50 +3568,50 @@ resize_frame_windows (struct frame *f, int size, int horflag) - ((FRAME_HAS_MINIBUF_P (f) && !FRAME_MINIBUF_ONLY_P (f)) ? 1 : 0))); - XSETFASTINT (WVAR (r, top_line), FRAME_TOP_MARGIN (f)); - if (NILP (WVAR (r, vchild)) && NILP (WVAR (r, hchild))) + WSET (r, top_line, make_number (FRAME_TOP_MARGIN (f))); + if (NILP (r->vchild) && NILP (r->hchild)) /* For a leaf root window just set the size. */ if (horflag) - XSETFASTINT (WVAR (r, total_cols), new_size); + WSET (r, total_cols, make_number (new_size)); else - XSETFASTINT (WVAR (r, total_lines), new_size); + WSET (r, total_lines, make_number (new_size)); else { /* old_size is the old size of the frame's root window. */ - int old_size = XFASTINT (horflag ? WVAR (r, total_cols) - : WVAR (r, total_lines)); + int old_size = XFASTINT (horflag ? r->total_cols + : r->total_lines); Lisp_Object delta; XSETINT (delta, new_size - old_size); /* Try a "normal" resize first. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qnil); if (window_resize_check (r, horflag) - && new_size == XINT (WVAR (r, new_total))) + && new_size == XINT (r->new_total)) window_resize_apply (r, horflag); else { /* Try with "reasonable" minimum sizes next. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qt); if (window_resize_check (r, horflag) - && new_size == XINT (WVAR (r, new_total))) + && new_size == XINT (r->new_total)) window_resize_apply (r, horflag); else { /* Finally, try with "safe" minimum sizes. */ resize_root_window (root, delta, horflag ? Qt : Qnil, Qsafe); if (window_resize_check (r, horflag) - && new_size == XINT (WVAR (r, new_total))) + && new_size == XINT (r->new_total)) window_resize_apply (r, horflag); else { /* We lost. Delete all windows but the frame's selected one. */ - root = FVAR (f, selected_window); + root = f->selected_window; Fdelete_other_windows_internal (root, Qnil); if (horflag) - XSETFASTINT (WVAR (XWINDOW (root), total_cols), new_size); + WSET (XWINDOW (root), total_cols, make_number (new_size)); else - XSETFASTINT (WVAR (XWINDOW (root), total_lines), new_size); + WSET (XWINDOW (root), total_lines, make_number (new_size)); } } } @@ -3629,13 +3621,13 @@ resize_frame_windows (struct frame *f, int size, int horflag) { m = XWINDOW (mini); if (horflag) - XSETFASTINT (WVAR (m, total_cols), size); + WSET (m, total_cols, make_number (size)); else { /* Are we sure we always want 1 line here? */ - XSETFASTINT (WVAR (m, total_lines), 1); - XSETFASTINT (WVAR (m, top_line), XINT (WVAR (r, top_line)) - + XINT (WVAR (r, total_lines))); + WSET (m, total_lines, make_number (1)); + WSET (m, top_line, + make_number (XINT (r->top_line) + XINT (r->total_lines))); } } } @@ -3691,10 +3683,10 @@ set correctly. See the code of `split-window' for how this is done. */) parent, or OLD is ortho-combined. */ combination_limit = !NILP (Vwindow_combination_limit) - || NILP (WVAR (o, parent)) + || NILP (o->parent) || NILP (horflag - ? (WVAR (XWINDOW (WVAR (o, parent)), hchild)) - : (WVAR (XWINDOW (WVAR (o, parent)), vchild))); + ? (XWINDOW (o->parent)->hchild) + : (XWINDOW (o->parent)->vchild)); /* We need a live reference window to initialize some parameters. */ if (WINDOW_LIVE_P (old)) @@ -3714,24 +3706,24 @@ set correctly. See the code of `split-window' for how this is done. */) /* `window-combination-resize' non-nil means try to resize OLD's siblings proportionally. */ { - p = XWINDOW (WVAR (o, parent)); + p = XWINDOW (o->parent); /* Temporarily pretend we split the parent window. */ - XSETINT (WVAR (p, new_total), - XINT (horflag ? WVAR (p, total_cols) : WVAR (p, total_lines)) - - XINT (total_size)); + WSET (p, new_total, + make_number (XINT (horflag ? p->total_cols : p->total_lines) + - XINT (total_size))); if (!window_resize_check (p, horflag)) error ("Window sizes don't fit"); else /* Undo the temporary pretension. */ - WVAR (p, new_total) - = horflag ? WVAR (p, total_cols) : WVAR (p, total_lines); + WSET (p, new_total, + horflag ? p->total_cols : p->total_lines); } else { if (!window_resize_check (o, horflag)) error ("Resizing old window failed"); - else if (XINT (total_size) + XINT (WVAR (o, new_total)) - != XINT (horflag ? WVAR (o, total_cols) : WVAR (o, total_lines))) + else if (XINT (total_size) + XINT (o->new_total) + != XINT (horflag ? o->total_cols : o->total_lines)) error ("Sum of sizes of old and new window don't fit"); } @@ -3742,94 +3734,94 @@ set correctly. See the code of `split-window' for how this is done. */) by make_parent_window and we need it below for assigning it to p->new_normal. */ Lisp_Object new_normal - = horflag ? WVAR (o, normal_cols) : WVAR (o, normal_lines); + = horflag ? o->normal_cols : o->normal_lines; make_parent_window (old, horflag); - p = XWINDOW (WVAR (o, parent)); + p = XWINDOW (o->parent); /* Store value of `window-combination-limit' in new parent's combination_limit slot. */ - WVAR (p, combination_limit) = Vwindow_combination_limit; + WSET (p, combination_limit, Vwindow_combination_limit); /* These get applied below. */ - WVAR (p, new_total) - = horflag ? WVAR (o, total_cols) : WVAR (o, total_lines); - WVAR (p, new_normal) = new_normal; + WSET (p, new_total, horflag ? o->total_cols : o->total_lines); + WSET (p, new_normal, new_normal); } else - p = XWINDOW (WVAR (o, parent)); + p = XWINDOW (o->parent); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; new = make_window (); n = XWINDOW (new); - WVAR (n, frame) = frame; - WVAR (n, parent) = WVAR (o, parent); - WVAR (n, vchild) = WVAR (n, hchild) = Qnil; + WSET (n, frame, frame); + WSET (n, parent, o->parent); + WSET (n, vchild, Qnil); + WSET (n, hchild, Qnil); if (EQ (side, Qabove) || EQ (side, Qleft)) { - WVAR (n, prev) = WVAR (o, prev); - if (NILP (WVAR (n, prev))) + WSET (n, prev, o->prev); + if (NILP (n->prev)) if (horflag) - WVAR (p, hchild) = new; + WSET (p, hchild, new); else - WVAR (p, vchild) = new; + WSET (p, vchild, new); else - WVAR (XWINDOW (WVAR (n, prev)), next) = new; - WVAR (n, next) = old; - WVAR (o, prev) = new; + WSET (XWINDOW (n->prev), next, new); + WSET (n, next, old); + WSET (o, prev, new); } else { - WVAR (n, next) = WVAR (o, next); - if (!NILP (WVAR (n, next))) - WVAR (XWINDOW (WVAR (n, next)), prev) = new; - WVAR (n, prev) = old; - WVAR (o, next) = new; + WSET (n, next, o->next); + if (!NILP (n->next)) + WSET (XWINDOW (n->next), prev, new); + WSET (n, prev, old); + WSET (o, next, new); } - WVAR (n, buffer) = Qt; - WVAR (n, window_end_valid) = Qnil; + WSET (n, buffer, Qt); + WSET (n, window_end_valid, Qnil); memset (&n->last_cursor, 0, sizeof n->last_cursor); /* Get special geometry settings from reference window. */ - WVAR (n, left_margin_cols) = WVAR (r, left_margin_cols); - WVAR (n, right_margin_cols) = WVAR (r, right_margin_cols); - WVAR (n, left_fringe_width) = WVAR (r, left_fringe_width); - WVAR (n, right_fringe_width) = WVAR (r, right_fringe_width); + WSET (n, left_margin_cols, r->left_margin_cols); + WSET (n, right_margin_cols, r->right_margin_cols); + WSET (n, left_fringe_width, r->left_fringe_width); + WSET (n, right_fringe_width, r->right_fringe_width); n->fringes_outside_margins = r->fringes_outside_margins; - WVAR (n, scroll_bar_width) = WVAR (r, scroll_bar_width); - WVAR (n, vertical_scroll_bar_type) = WVAR (r, vertical_scroll_bar_type); + WSET (n, scroll_bar_width, r->scroll_bar_width); + WSET (n, vertical_scroll_bar_type, r->vertical_scroll_bar_type); /* Directly assign orthogonal coordinates and sizes. */ if (horflag) { - WVAR (n, top_line) = WVAR (o, top_line); - WVAR (n, total_lines) = WVAR (o, total_lines); + WSET (n, top_line, o->top_line); + WSET (n, total_lines, o->total_lines); } else { - WVAR (n, left_col) = WVAR (o, left_col); - WVAR (n, total_cols) = WVAR (o, total_cols); + WSET (n, left_col, o->left_col); + WSET (n, total_cols, o->total_cols); } /* Iso-coordinates and sizes are assigned by window_resize_apply, get them ready here. */ - WVAR (n, new_total) = total_size; - WVAR (n, new_normal) = normal_size; + WSET (n, new_total, total_size); + WSET (n, new_normal, normal_size); BLOCK_INPUT; window_resize_apply (p, horflag); adjust_glyphs (f); /* Set buffer of NEW to buffer of reference window. Don't run any hooks. */ - set_window_buffer (new, WVAR (r, buffer), 0, 1); + set_window_buffer (new, r->buffer, 0, 1); UNBLOCK_INPUT; /* Maybe we should run the scroll functions in Elisp (which already runs the configuration change hook). */ if (! NILP (Vwindow_scroll_functions)) run_hook_with_args_2 (Qwindow_scroll_functions, new, - Fmarker_position (WVAR (n, start))); + Fmarker_position (n->start)); /* Return NEW. */ return new; } @@ -3848,23 +3840,25 @@ Signal an error when WINDOW is the only window on its frame. */) int before_sibling = 0; w = decode_any_window (window); + CHECK_LIVE_FRAME (w->frame); + XSETWINDOW (window, w); - if (NILP (WVAR (w, buffer)) - && NILP (WVAR (w, hchild)) && NILP (WVAR (w, vchild))) + if (NILP (w->buffer) + && NILP (w->hchild) && NILP (w->vchild)) /* It's a no-op to delete an already deleted window. */ return Qnil; - parent = WVAR (w, parent); + parent = w->parent; if (NILP (parent)) /* Never delete a minibuffer or frame root window. */ error ("Attempt to delete minibuffer or sole ordinary window"); - else if (NILP (WVAR (w, prev)) && NILP (WVAR (w, next))) + else if (NILP (w->prev) && NILP (w->next)) /* Rather bow out here, this case should be handled on the Elisp level. */ error ("Attempt to delete sole window of parent"); p = XWINDOW (parent); - horflag = NILP (WVAR (p, vchild)); + horflag = NILP (p->vchild); frame = WINDOW_FRAME (w); f = XFRAME (frame); @@ -3873,33 +3867,33 @@ Signal an error when WINDOW is the only window on its frame. */) r = XWINDOW (root); /* Unlink WINDOW from window tree. */ - if (NILP (WVAR (w, prev))) + if (NILP (w->prev)) /* Get SIBLING below (on the right of) WINDOW. */ { /* before_sibling 1 means WINDOW is the first child of its parent and thus before the sibling. */ before_sibling = 1; - sibling = WVAR (w, next); + sibling = w->next; s = XWINDOW (sibling); - WVAR (s, prev) = Qnil; + WSET (s, prev, Qnil); if (horflag) - WVAR (p, hchild) = sibling; + WSET (p, hchild, sibling); else - WVAR (p, vchild) = sibling; + WSET (p, vchild, sibling); } else /* Get SIBLING above (on the left of) WINDOW. */ { - sibling = WVAR (w, prev); + sibling = w->prev; s = XWINDOW (sibling); - WVAR (s, next) = WVAR (w, next); - if (!NILP (WVAR (s, next))) - WVAR (XWINDOW (WVAR (s, next)), prev) = sibling; + WSET (s, next, w->next); + if (!NILP (s->next)) + WSET (XWINDOW (s->next), prev, sibling); } if (window_resize_check (r, horflag) - && EQ (WVAR (r, new_total), - (horflag ? WVAR (r, total_cols) : WVAR (r, total_lines)))) + && EQ (r->new_total, + (horflag ? r->total_cols : r->total_lines))) /* We can delete WINDOW now. */ { @@ -3924,28 +3918,28 @@ Signal an error when WINDOW is the only window on its frame. */) Vwindow_list = Qnil; FRAME_WINDOW_SIZES_CHANGED (f) = 1; - WVAR (w, next) = Qnil; /* Don't delete w->next too. */ + WSET (w, next, Qnil); /* Don't delete w->next too. */ free_window_matrices (w); - if (!NILP (WVAR (w, vchild))) + if (!NILP (w->vchild)) { - delete_all_child_windows (WVAR (w, vchild)); - WVAR (w, vchild) = Qnil; + delete_all_child_windows (w->vchild); + WSET (w, vchild, Qnil); } - else if (!NILP (WVAR (w, hchild))) + else if (!NILP (w->hchild)) { - delete_all_child_windows (WVAR (w, hchild)); - WVAR (w, hchild) = Qnil; + delete_all_child_windows (w->hchild); + WSET (w, hchild, Qnil); } - else if (!NILP (WVAR (w, buffer))) + else if (!NILP (w->buffer)) { unshow_buffer (w); - unchain_marker (XMARKER (WVAR (w, pointm))); - unchain_marker (XMARKER (WVAR (w, start))); - WVAR (w, buffer) = Qnil; + unchain_marker (XMARKER (w->pointm)); + unchain_marker (XMARKER (w->start)); + WSET (w, buffer, Qnil); } - if (NILP (WVAR (s, prev)) && NILP (WVAR (s, next))) + if (NILP (s->prev) && NILP (s->next)) /* A matrjoshka where SIBLING has become the only child of PARENT. */ { @@ -3953,10 +3947,11 @@ Signal an error when WINDOW is the only window on its frame. */) replace_window (parent, sibling, 0); /* Have SIBLING inherit the following three slot values from PARENT (the combination_limit slot is not inherited). */ - WVAR (s, normal_cols) = WVAR (p, normal_cols); - WVAR (s, normal_lines) = WVAR (p, normal_lines); + WSET (s, normal_cols, p->normal_cols); + WSET (s, normal_lines, p->normal_lines); /* Mark PARENT as deleted. */ - WVAR (p, vchild) = WVAR (p, hchild) = Qnil; + WSET (p, vchild, Qnil); + WSET (p, hchild, Qnil); /* Try to merge SIBLING into its new parent. */ recombine_windows (sibling); } @@ -3976,21 +3971,21 @@ Signal an error when WINDOW is the only window on its frame. */) if (EQ (FRAME_SELECTED_WINDOW (f), selected_window)) Fselect_window (new_selected_window, Qt); else - FRAME_SELECTED_WINDOW (f) = new_selected_window; + FSET (f, selected_window, new_selected_window); UNBLOCK_INPUT; /* Now look whether `get-mru-window' gets us something. */ mru_window = call1 (Qget_mru_window, frame); if (WINDOW_LIVE_P (mru_window) - && EQ (WVAR (XWINDOW (mru_window), frame), frame)) + && EQ (XWINDOW (mru_window)->frame, frame)) new_selected_window = mru_window; /* If all ended up well, we now promote the mru window. */ if (EQ (FRAME_SELECTED_WINDOW (f), selected_window)) Fselect_window (new_selected_window, Qnil); else - FRAME_SELECTED_WINDOW (f) = new_selected_window; + FSET (f, selected_window, new_selected_window); } else UNBLOCK_INPUT; @@ -4003,17 +3998,17 @@ Signal an error when WINDOW is the only window on its frame. */) { if (before_sibling) { - WVAR (s, prev) = window; + WSET (s, prev, window); if (horflag) - WVAR (p, hchild) = window; + WSET (p, hchild, window); else - WVAR (p, vchild) = window; + WSET (p, vchild, window); } else { - WVAR (s, next) = window; - if (!NILP (WVAR (w, next))) - WVAR (XWINDOW (WVAR (w, next)), prev) = window; + WSET (s, next, window); + if (!NILP (w->next)) + WSET (XWINDOW (w->next), prev, window); } error ("Deletion failed"); } @@ -4030,7 +4025,7 @@ Signal an error when WINDOW is the only window on its frame. */) void grow_mini_window (struct window *w, int delta) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct window *r; Lisp_Object root, value; @@ -4047,9 +4042,10 @@ grow_mini_window (struct window *w, int delta) window_resize_apply (r, 0); /* Grow the mini-window. */ - XSETFASTINT (WVAR (w, top_line), - XFASTINT (WVAR (r, top_line)) + XFASTINT (WVAR (r, total_lines))); - XSETFASTINT (WVAR (w, total_lines), XFASTINT (WVAR (w, total_lines)) - XINT (value)); + WSET (w, top_line, + make_number (XFASTINT (r->top_line) + XFASTINT (r->total_lines))); + WSET (w, total_lines, + make_number (XFASTINT (w->total_lines) - XINT (value))); w->last_modified = 0; w->last_overlay_modified = 0; @@ -4063,14 +4059,14 @@ grow_mini_window (struct window *w, int delta) void shrink_mini_window (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct window *r; Lisp_Object root, value; EMACS_INT size; eassert (MINI_WINDOW_P (w)); - size = XINT (WVAR (w, total_lines)); + size = XINT (w->total_lines); if (size > 1) { root = FRAME_ROOT_WINDOW (f); @@ -4083,9 +4079,9 @@ shrink_mini_window (struct window *w) window_resize_apply (r, 0); /* Shrink the mini-window. */ - XSETFASTINT (WVAR (w, top_line), XFASTINT (WVAR (r, top_line)) - + XFASTINT (WVAR (r, total_lines))); - XSETFASTINT (WVAR (w, total_lines), 1); + WSET (w, top_line, + make_number (XFASTINT (r->top_line) + XFASTINT (r->total_lines))); + WSET (w, total_lines, make_number (1)); w->last_modified = 0; w->last_overlay_modified = 0; @@ -4110,25 +4106,25 @@ DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, Sresize_mini int height; CHECK_WINDOW (window); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); - if (!EQ (FRAME_MINIBUF_WINDOW (XFRAME (WVAR (w, frame))), window)) + if (!EQ (FRAME_MINIBUF_WINDOW (XFRAME (w->frame)), window)) error ("Not a valid minibuffer window"); else if (FRAME_MINIBUF_ONLY_P (f)) error ("Cannot resize a minibuffer-only frame"); r = XWINDOW (FRAME_ROOT_WINDOW (f)); - height = XINT (WVAR (r, total_lines)) + XINT (WVAR (w, total_lines)); + height = XINT (r->total_lines) + XINT (w->total_lines); if (window_resize_check (r, 0) - && XINT (WVAR (w, new_total)) > 0 - && height == XINT (WVAR (r, new_total)) + XINT (WVAR (w, new_total))) + && XINT (w->new_total) > 0 + && height == XINT (r->new_total) + XINT (w->new_total)) { BLOCK_INPUT; window_resize_apply (r, 0); - WVAR (w, total_lines) = WVAR (w, new_total); - XSETFASTINT (WVAR (w, top_line), - XINT (WVAR (r, top_line)) + XINT (WVAR (r, total_lines))); + WSET (w, total_lines, w->new_total); + WSET (w, top_line, + make_number (XINT (r->top_line) + XINT (r->total_lines))); windows_or_buffers_changed++; FRAME_WINDOW_SIZES_CHANGED (f) = 1; @@ -4151,14 +4147,14 @@ mark_window_cursors_off (struct window *w) { while (w) { - if (!NILP (WVAR (w, hchild))) - mark_window_cursors_off (XWINDOW (WVAR (w, hchild))); - else if (!NILP (WVAR (w, vchild))) - mark_window_cursors_off (XWINDOW (WVAR (w, vchild))); + if (!NILP (w->hchild)) + mark_window_cursors_off (XWINDOW (w->hchild)); + else if (!NILP (w->vchild)) + mark_window_cursors_off (XWINDOW (w->vchild)); else w->phys_cursor_on_p = 0; - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -4168,15 +4164,15 @@ mark_window_cursors_off (struct window *w) int window_internal_height (struct window *w) { - int ht = XFASTINT (WVAR (w, total_lines)); + int ht = XFASTINT (w->total_lines); if (!MINI_WINDOW_P (w)) { - if (!NILP (WVAR (w, parent)) - || !NILP (WVAR (w, vchild)) - || !NILP (WVAR (w, hchild)) - || !NILP (WVAR (w, next)) - || !NILP (WVAR (w, prev)) + if (!NILP (w->parent) + || !NILP (w->vchild) + || !NILP (w->hchild) + || !NILP (w->next) + || !NILP (w->prev) || WINDOW_WANTS_MODELINE_P (w)) --ht; @@ -4206,7 +4202,7 @@ window_scroll (Lisp_Object window, EMACS_INT n, int whole, int noerror) /* If we must, use the pixel-based version which is much slower than the line-based one but can handle varying line heights. */ - if (FRAME_WINDOW_P (XFRAME (WVAR (XWINDOW (window), frame)))) + if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame))) window_scroll_pixel_based (window, n, whole, noerror); else window_scroll_line_based (window, n, whole, noerror); @@ -4231,7 +4227,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) int x, y, rtop, rbot, rowh, vpos; void *itdata = NULL; - SET_TEXT_POS_FROM_MARKER (start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start, w->start); /* Scrolling a minibuffer window via scroll bar when the echo area shows long text sometimes resets the minibuffer contents behind our backs. */ @@ -4312,8 +4308,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) spos = XINT (Fline_beginning_position (Qnil)); else spos = min (XINT (Fline_end_position (Qnil)) + 1, ZV); - set_marker_restricted (WVAR (w, start), make_number (spos), - WVAR (w, buffer)); + set_marker_restricted (w->start, make_number (spos), + w->buffer); w->start_at_line_beg = 1; w->update_mode_line = 1; w->last_modified = 0; @@ -4437,7 +4433,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) /* If control gets here, then we vscrolled. */ - XBUFFER (WVAR (w, buffer))->prevent_redisplay_optimizations_p = 1; + XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; /* Don't try to change the window start below. */ vscrolled = 1; @@ -4457,9 +4453,9 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) } /* Set the window start, and set up the window for redisplay. */ - set_marker_restricted (WVAR (w, start), make_number (pos), - WVAR (w, buffer)); - bytepos = XMARKER (WVAR (w, start))->bytepos; + set_marker_restricted (w->start, make_number (pos), + w->buffer); + bytepos = XMARKER (w->start)->bytepos; w->start_at_line_beg = (pos == BEGV || FETCH_BYTE (bytepos - 1) == '\n'); w->update_mode_line = 1; w->last_modified = 0; @@ -4478,7 +4474,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) even if there is a header line. */ this_scroll_margin = max (0, scroll_margin); this_scroll_margin - = min (this_scroll_margin, XFASTINT (WVAR (w, total_lines)) / 4); + = min (this_scroll_margin, XFASTINT (w->total_lines) / 4); this_scroll_margin *= FRAME_LINE_HEIGHT (it.f); if (n > 0) @@ -4552,7 +4548,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) ; else if (window_scroll_pixel_based_preserve_y >= 0) { - SET_TEXT_POS_FROM_MARKER (start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start, w->start); start_display (&it, w, start); /* It would be wrong to subtract CURRENT_HEADER_LINE_HEIGHT here because we called start_display again and did not @@ -4606,7 +4602,7 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror) if (whole) n *= max (1, ht - next_screen_context_lines); - startpos = marker_position (WVAR (w, start)); + startpos = marker_position (w->start); if (!NILP (Vscroll_preserve_screen_position)) { @@ -4657,9 +4653,9 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror) { /* Don't use a scroll margin that is negative or too large. */ int this_scroll_margin = - max (0, min (scroll_margin, XINT (WVAR (w, total_lines)) / 4)); + max (0, min (scroll_margin, XINT (w->total_lines) / 4)); - set_marker_restricted_both (WVAR (w, start), WVAR (w, buffer), pos, pos_byte); + set_marker_restricted_both (w->start, w->buffer, pos, pos_byte); w->start_at_line_beg = !NILP (bolp); w->update_mode_line = 1; w->last_modified = 0; @@ -4753,10 +4749,10 @@ scroll_command (Lisp_Object n, int direction) /* If selected window's buffer isn't current, make it current for the moment. But don't screw up if window_scroll gets an error. */ - if (XBUFFER (WVAR (XWINDOW (selected_window), buffer)) != current_buffer) + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) { record_unwind_protect (save_excursion_restore, save_excursion_save ()); - Fset_buffer (WVAR (XWINDOW (selected_window), buffer)); + Fset_buffer (XWINDOW (selected_window)->buffer); /* Make redisplay consider other windows than just selected_window. */ ++windows_or_buffers_changed; @@ -4871,8 +4867,8 @@ specifies the window to scroll. This takes precedence over record_unwind_protect (save_excursion_restore, save_excursion_save ()); ++windows_or_buffers_changed; - Fset_buffer (WVAR (w, buffer)); - SET_PT (marker_position (WVAR (w, pointm))); + Fset_buffer (w->buffer); + SET_PT (marker_position (w->pointm)); if (NILP (arg)) window_scroll (window, 1, 1, 1); @@ -4886,7 +4882,7 @@ specifies the window to scroll. This takes precedence over window_scroll (window, XINT (arg), 0, 1); } - set_marker_both (WVAR (w, pointm), Qnil, PT, PT_BYTE); + set_marker_both (w->pointm, Qnil, PT, PT_BYTE); unbind_to (count, Qnil); return Qnil; @@ -4964,10 +4960,10 @@ displayed_window_lines (struct window *w) int bottom_y; void *itdata = NULL; - if (XBUFFER (WVAR (w, buffer)) != current_buffer) + if (XBUFFER (w->buffer) != current_buffer) { old_buffer = current_buffer; - set_buffer_internal (XBUFFER (WVAR (w, buffer))); + set_buffer_internal (XBUFFER (w->buffer)); } else old_buffer = NULL; @@ -4975,12 +4971,12 @@ displayed_window_lines (struct window *w) /* In case W->start is out of the accessible range, do something reasonable. This happens in Info mode when Info-scroll-down calls (recenter -1) while W->start is 1. */ - if (XMARKER (WVAR (w, start))->charpos < BEGV) + if (XMARKER (w->start)->charpos < BEGV) SET_TEXT_POS (start, BEGV, BEGV_BYTE); - else if (XMARKER (WVAR (w, start))->charpos > ZV) + else if (XMARKER (w->start)->charpos > ZV) SET_TEXT_POS (start, ZV, ZV_BYTE); else - SET_TEXT_POS_FROM_MARKER (start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start, w->start); itdata = bidi_shelve_cache (); start_display (&it, w, start); @@ -4994,7 +4990,7 @@ displayed_window_lines (struct window *w) This kludge fixes a bug whereby (move-to-window-line -1) when ZV is on the last screen line moves to the previous screen line instead of the last one. */ - if (! FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))) + if (! FRAME_WINDOW_P (XFRAME (w->frame))) height++; /* Add in empty lines at the bottom of the window. */ @@ -5029,7 +5025,7 @@ and redisplay normally--don't erase and redraw the frame. */) (register Lisp_Object arg) { struct window *w = XWINDOW (selected_window); - struct buffer *buf = XBUFFER (WVAR (w, buffer)); + struct buffer *buf = XBUFFER (w->buffer); struct buffer *obuf = current_buffer; int center_p = 0; ptrdiff_t charpos, bytepos; @@ -5073,12 +5069,12 @@ and redisplay normally--don't erase and redraw the frame. */) /* Do this after making BUF current in case scroll_margin is buffer-local. */ this_scroll_margin = - max (0, min (scroll_margin, XFASTINT (WVAR (w, total_lines)) / 4)); + max (0, min (scroll_margin, XFASTINT (w->total_lines) / 4)); /* Handle centering on a graphical frame specially. Such frames can have variable-height lines and centering point on the basis of line counts would lead to strange effects. */ - if (FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))) + if (FRAME_WINDOW_P (XFRAME (w->frame))) { if (center_p) { @@ -5195,8 +5191,8 @@ and redisplay normally--don't erase and redraw the frame. */) } /* Set the new window start. */ - set_marker_both (WVAR (w, start), WVAR (w, buffer), charpos, bytepos); - WVAR (w, window_end_valid) = Qnil; + set_marker_both (w->start, w->buffer, charpos, bytepos); + WSET (w, window_end_valid, Qnil); w->optional_new_start = 1; @@ -5218,7 +5214,7 @@ nor any partial-height lines at the bottom of the text area. */) { struct window *w = decode_window (window); int pixel_height = window_box_height (w); - int line_height = pixel_height / FRAME_LINE_HEIGHT (XFRAME (WVAR (w, frame))); + int line_height = pixel_height / FRAME_LINE_HEIGHT (XFRAME (w->frame)); return make_number (line_height); } @@ -5239,24 +5235,24 @@ zero means top of window, negative means relative to bottom of window. */) int this_scroll_margin; #endif - if (!(BUFFERP (WVAR (w, buffer)) - && XBUFFER (WVAR (w, buffer)) == current_buffer)) + if (!(BUFFERP (w->buffer) + && XBUFFER (w->buffer) == current_buffer)) /* This test is needed to make sure PT/PT_BYTE make sense in w->buffer when passed below to set_marker_both. */ error ("move-to-window-line called from unrelated buffer"); window = selected_window; - start = marker_position (WVAR (w, start)); + start = marker_position (w->start); if (start < BEGV || start > ZV) { int height = window_internal_height (w); Fvertical_motion (make_number (- (height / 2)), window); - set_marker_both (WVAR (w, start), WVAR (w, buffer), PT, PT_BYTE); + set_marker_both (w->start, w->buffer, PT, PT_BYTE); w->start_at_line_beg = !NILP (Fbolp ()); w->force_start = 1; } else - Fgoto_char (WVAR (w, start)); + Fgoto_char (w->start); lines = displayed_window_lines (w); @@ -5360,7 +5356,7 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config data = (struct save_window_data *) XVECTOR (config); saved_windows = XVECTOR (data->saved_windows); - return WVAR (XWINDOW (SAVED_WINDOW_N (saved_windows, 0)->window), frame); + return XWINDOW (SAVED_WINDOW_N (saved_windows, 0)->window)->frame; } DEFUN ("set-window-configuration", Fset_window_configuration, @@ -5402,11 +5398,11 @@ the return value is nil. Otherwise the value is t. */) window-point of the final-selected-window to the window-point of the current-selected-window. So we have to be careful which point of the current-buffer we copy into old_point. */ - if (EQ (WVAR (XWINDOW (data->current_window), buffer), new_current_buffer) + if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer) && WINDOWP (selected_window) - && EQ (WVAR (XWINDOW (selected_window), buffer), new_current_buffer) + && EQ (XWINDOW (selected_window)->buffer, new_current_buffer) && !EQ (selected_window, data->current_window)) - old_point = XMARKER (WVAR (XWINDOW (data->current_window), pointm))->charpos; + old_point = XMARKER (XWINDOW (data->current_window)->pointm)->charpos; else old_point = PT; else @@ -5418,15 +5414,15 @@ the return value is nil. Otherwise the value is t. */) So if possible we want this arbitrary choice of "which point" to be the one from the to-be-selected-window so as to prevent this window's cursor from being copied from another window. */ - if (EQ (WVAR (XWINDOW (data->current_window), buffer), new_current_buffer) + if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer) /* If current_window = selected_window, its point is in BUF_PT. */ && !EQ (selected_window, data->current_window)) - old_point = XMARKER (WVAR (XWINDOW (data->current_window), pointm))->charpos; + old_point = XMARKER (XWINDOW (data->current_window)->pointm)->charpos; else old_point = BUF_PT (XBUFFER (new_current_buffer)); } - frame = WVAR (XWINDOW (SAVED_WINDOW_N (saved_windows, 0)->window), frame); + frame = XWINDOW (SAVED_WINDOW_N (saved_windows, 0)->window)->frame; f = XFRAME (frame); /* If f is a dead frame, don't bother rebuilding its window tree. @@ -5479,13 +5475,13 @@ the return value is nil. Otherwise the value is t. */) window holds garbage.) We do this now, before restoring the window contents, and prevent it from being done later on when we select a new window. */ - if (! NILP (WVAR (XWINDOW (selected_window), buffer))) + if (! NILP (XWINDOW (selected_window)->buffer)) { w = XWINDOW (selected_window); - set_marker_both (WVAR (w, pointm), - WVAR (w, buffer), - BUF_PT (XBUFFER (WVAR (w, buffer))), - BUF_PT_BYTE (XBUFFER (WVAR (w, buffer)))); + set_marker_both (w->pointm, + w->buffer, + BUF_PT (XBUFFER (w->buffer)), + BUF_PT_BYTE (XBUFFER (w->buffer))); } windows_or_buffers_changed++; @@ -5514,60 +5510,60 @@ the return value is nil. Otherwise the value is t. */) p = SAVED_WINDOW_N (saved_windows, k); window = p->window; w = XWINDOW (window); - WVAR (w, next) = Qnil; + WSET (w, next, Qnil); if (!NILP (p->parent)) - WVAR (w, parent) = SAVED_WINDOW_N (saved_windows, - XFASTINT (p->parent))->window; + WSET (w, parent, SAVED_WINDOW_N + (saved_windows, XFASTINT (p->parent))->window); else - WVAR (w, parent) = Qnil; + WSET (w, parent, Qnil); if (!NILP (p->prev)) { - WVAR (w, prev) = SAVED_WINDOW_N (saved_windows, - XFASTINT (p->prev))->window; - WVAR (XWINDOW (WVAR (w, prev)), next) = p->window; + WSET (w, prev, SAVED_WINDOW_N + (saved_windows, XFASTINT (p->prev))->window); + WSET (XWINDOW (w->prev), next, p->window); } else { - WVAR (w, prev) = Qnil; - if (!NILP (WVAR (w, parent))) + WSET (w, prev, Qnil); + if (!NILP (w->parent)) { - if (EQ (p->total_cols, WVAR (XWINDOW (WVAR (w, parent)), total_cols))) + if (EQ (p->total_cols, XWINDOW (w->parent)->total_cols)) { - WVAR (XWINDOW (WVAR (w, parent)), vchild) = p->window; - WVAR (XWINDOW (WVAR (w, parent)), hchild) = Qnil; + WSET (XWINDOW (w->parent), vchild, p->window); + WSET (XWINDOW (w->parent), hchild, Qnil); } else { - WVAR (XWINDOW (WVAR (w, parent)), hchild) = p->window; - WVAR (XWINDOW (WVAR (w, parent)), vchild) = Qnil; + WSET (XWINDOW (w->parent), hchild, p->window); + WSET (XWINDOW (w->parent), vchild, Qnil); } } } /* If we squirreled away the buffer in the window's height, restore it now. */ - if (BUFFERP (WVAR (w, total_lines))) - WVAR (w, buffer) = WVAR (w, total_lines); - WVAR (w, left_col) = p->left_col; - WVAR (w, top_line) = p->top_line; - WVAR (w, total_cols) = p->total_cols; - WVAR (w, total_lines) = p->total_lines; - WVAR (w, normal_cols) = p->normal_cols; - WVAR (w, normal_lines) = p->normal_lines; + if (BUFFERP (w->total_lines)) + WSET (w, buffer, w->total_lines); + WSET (w, left_col, p->left_col); + WSET (w, top_line, p->top_line); + WSET (w, total_cols, p->total_cols); + WSET (w, total_lines, p->total_lines); + WSET (w, normal_cols, p->normal_cols); + WSET (w, normal_lines, p->normal_lines); w->hscroll = XFASTINT (p->hscroll); w->min_hscroll = XFASTINT (p->min_hscroll); - WVAR (w, display_table) = p->display_table; - WVAR (w, left_margin_cols) = p->left_margin_cols; - WVAR (w, right_margin_cols) = p->right_margin_cols; - WVAR (w, left_fringe_width) = p->left_fringe_width; - WVAR (w, right_fringe_width) = p->right_fringe_width; + WSET (w, display_table, p->display_table); + WSET (w, left_margin_cols, p->left_margin_cols); + WSET (w, right_margin_cols, p->right_margin_cols); + WSET (w, left_fringe_width, p->left_fringe_width); + WSET (w, right_fringe_width, p->right_fringe_width); w->fringes_outside_margins = !NILP (p->fringes_outside_margins); - WVAR (w, scroll_bar_width) = p->scroll_bar_width; - WVAR (w, vertical_scroll_bar_type) = p->vertical_scroll_bar_type; - WVAR (w, dedicated) = p->dedicated; - WVAR (w, combination_limit) = p->combination_limit; + WSET (w, scroll_bar_width, p->scroll_bar_width); + WSET (w, vertical_scroll_bar_type, p->vertical_scroll_bar_type); + WSET (w, dedicated, p->dedicated); + WSET (w, combination_limit, p->combination_limit); /* Restore any window parameters that have been saved. Parameters that have not been saved are left alone. */ for (tem = p->window_parameters; CONSP (tem); tem = XCDR (tem)) @@ -5577,7 +5573,7 @@ the return value is nil. Otherwise the value is t. */) { if (NILP (XCDR (pers))) { - par = Fassq (XCAR (pers), WVAR (w, window_parameters)); + par = Fassq (XCAR (pers), w->window_parameters); if (CONSP (par) && !NILP (XCDR (par))) /* Reset a parameter to nil if and only if it has a non-nil association. Don't make new @@ -5596,50 +5592,50 @@ the return value is nil. Otherwise the value is t. */) /* Reinstall the saved buffer and pointers into it. */ if (NILP (p->buffer)) /* An internal window. */ - WVAR (w, buffer) = p->buffer; + WSET (w, buffer, p->buffer); else if (!NILP (BVAR (XBUFFER (p->buffer), name))) /* If saved buffer is alive, install it. */ { - WVAR (w, buffer) = p->buffer; - w->start_at_line_beg = !NILP (p->start_at_line_beg); - set_marker_restricted (WVAR (w, start), p->start, WVAR (w, buffer)); - set_marker_restricted (WVAR (w, pointm), p->pointm, - WVAR (w, buffer)); - Fset_marker (BVAR (XBUFFER (WVAR (w, buffer)), mark), - p->mark, WVAR (w, buffer)); + WSET (w, buffer, p->buffer); + w->start_at_line_beg = !NILP (p->start_at_line_beg); + set_marker_restricted (w->start, p->start, w->buffer); + set_marker_restricted (w->pointm, p->pointm, + w->buffer); + Fset_marker (BVAR (XBUFFER (w->buffer), mark), + p->mark, w->buffer); - /* As documented in Fcurrent_window_configuration, don't - restore the location of point in the buffer which was - current when the window configuration was recorded. */ - if (!EQ (p->buffer, new_current_buffer) - && XBUFFER (p->buffer) == current_buffer) - Fgoto_char (WVAR (w, pointm)); - } - else if (!NILP (WVAR (w, buffer)) - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), name))) - /* Keep window's old buffer; make sure the markers are - real. */ + /* As documented in Fcurrent_window_configuration, don't + restore the location of point in the buffer which was + current when the window configuration was recorded. */ + if (!EQ (p->buffer, new_current_buffer) + && XBUFFER (p->buffer) == current_buffer) + Fgoto_char (w->pointm); + } + else if (!NILP (w->buffer) + && !NILP (BVAR (XBUFFER (w->buffer), name))) + /* Keep window's old buffer; make sure the markers are + real. */ + { + /* Set window markers at start of visible range. */ + if (XMARKER (w->start)->buffer == 0) + set_marker_restricted (w->start, make_number (0), + w->buffer); + if (XMARKER (w->pointm)->buffer == 0) + set_marker_restricted_both + (w->pointm, w->buffer, + BUF_PT (XBUFFER (w->buffer)), + BUF_PT_BYTE (XBUFFER (w->buffer))); + w->start_at_line_beg = 1; + } + else if (STRINGP (auto_buffer_name = + Fwindow_parameter (window, Qauto_buffer_name)) + && SCHARS (auto_buffer_name) != 0 + && !NILP (WSET (w, buffer, Fget_buffer_create (auto_buffer_name)))) { - /* Set window markers at start of visible range. */ - if (XMARKER (WVAR (w, start))->buffer == 0) - set_marker_restricted (WVAR (w, start), make_number (0), - WVAR (w, buffer)); - if (XMARKER (WVAR (w, pointm))->buffer == 0) - set_marker_restricted_both - (WVAR (w, pointm), WVAR (w, buffer), - BUF_PT (XBUFFER (WVAR (w, buffer))), - BUF_PT_BYTE (XBUFFER (WVAR (w, buffer)))); - w->start_at_line_beg = 1; - } - else if (STRINGP (auto_buffer_name = - Fwindow_parameter (window, Qauto_buffer_name)) - && SCHARS (auto_buffer_name) != 0 - && !NILP (WVAR (w, buffer) = Fget_buffer_create (auto_buffer_name))) - { - set_marker_restricted (WVAR (w, start), - make_number (0), WVAR (w, buffer)); - set_marker_restricted (WVAR (w, pointm), - make_number (0), WVAR (w, buffer)); + set_marker_restricted (w->start, + make_number (0), w->buffer); + set_marker_restricted (w->pointm, + make_number (0), w->buffer); w->start_at_line_beg = 1; } else @@ -5649,36 +5645,36 @@ the return value is nil. Otherwise the value is t. */) avoid showing an unimportant buffer and, if necessary, to recreate *scratch* in the course (part of Juanma's bs-show scenario from March 2011). */ - WVAR (w, buffer) = other_buffer_safely (Fcurrent_buffer ()); + WSET (w, buffer, other_buffer_safely (Fcurrent_buffer ())); /* This will set the markers to beginning of visible range. */ - set_marker_restricted (WVAR (w, start), - make_number (0), WVAR (w, buffer)); - set_marker_restricted (WVAR (w, pointm), - make_number (0), WVAR (w, buffer)); + set_marker_restricted (w->start, + make_number (0), w->buffer); + set_marker_restricted (w->pointm, + make_number (0), w->buffer); w->start_at_line_beg = 1; - if (!NILP (WVAR (w, dedicated))) + if (!NILP (w->dedicated)) /* Record this window as dead. */ dead_windows = Fcons (window, dead_windows); /* Make sure window is no more dedicated. */ - WVAR (w, dedicated) = Qnil; + WSET (w, dedicated, Qnil); } } - FRAME_ROOT_WINDOW (f) = data->root_window; + FSET (f, root_window, data->root_window); /* Arrange *not* to restore point in the buffer that was current when the window configuration was saved. */ - if (EQ (WVAR (XWINDOW (data->current_window), buffer), new_current_buffer)) - set_marker_restricted (WVAR (XWINDOW (data->current_window), pointm), + if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer)) + set_marker_restricted (XWINDOW (data->current_window)->pointm, make_number (old_point), - WVAR (XWINDOW (data->current_window), buffer)); + XWINDOW (data->current_window)->buffer); /* In the following call to `select-window', prevent "swapping out point" in the old selected window using the buffer that has been restored into it. We already swapped out that point from that window's old buffer. */ select_window (data->current_window, Qnil, 1); - BVAR (XBUFFER (WVAR (XWINDOW (selected_window), buffer)), last_selected_window) + BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) = selected_window; if (NILP (data->focus_frame) @@ -5705,14 +5701,14 @@ the return value is nil. Otherwise the value is t. */) /* Now, free glyph matrices in windows that were not reused. */ for (i = n = 0; i < n_leaf_windows; ++i) { - if (NILP (WVAR (leaf_windows[i], buffer))) + if (NILP (leaf_windows[i]->buffer)) { /* Assert it's not reused as a combination. */ - eassert (NILP (WVAR (leaf_windows[i], hchild)) - && NILP (WVAR (leaf_windows[i], vchild))); + eassert (NILP (leaf_windows[i]->hchild) + && NILP (leaf_windows[i]->vchild)); free_window_matrices (leaf_windows[i]); } - else if (EQ (WVAR (leaf_windows[i], buffer), new_current_buffer)) + else if (EQ (leaf_windows[i]->buffer, new_current_buffer)) ++n; } @@ -5757,28 +5753,28 @@ delete_all_child_windows (Lisp_Object window) w = XWINDOW (window); - if (!NILP (WVAR (w, next))) + if (!NILP (w->next)) /* Delete WINDOW's siblings (we traverse postorderly). */ - delete_all_child_windows (WVAR (w, next)); + delete_all_child_windows (w->next); - WVAR (w, total_lines) = WVAR (w, buffer); /* See Fset_window_configuration for excuse. */ + WSET (w, total_lines, w->buffer); /* See Fset_window_configuration for excuse. */ - if (!NILP (WVAR (w, vchild))) + if (!NILP (w->vchild)) { - delete_all_child_windows (WVAR (w, vchild)); - WVAR (w, vchild) = Qnil; + delete_all_child_windows (w->vchild); + WSET (w, vchild, Qnil); } - else if (!NILP (WVAR (w, hchild))) + else if (!NILP (w->hchild)) { - delete_all_child_windows (WVAR (w, hchild)); - WVAR (w, hchild) = Qnil; + delete_all_child_windows (w->hchild); + WSET (w, hchild, Qnil); } - else if (!NILP (WVAR (w, buffer))) + else if (!NILP (w->buffer)) { unshow_buffer (w); - unchain_marker (XMARKER (WVAR (w, pointm))); - unchain_marker (XMARKER (WVAR (w, start))); - WVAR (w, buffer) = Qnil; + unchain_marker (XMARKER (w->pointm)); + unchain_marker (XMARKER (w->start)); + WSET (w, buffer, Qnil); } Vwindow_list = Qnil; @@ -5788,12 +5784,12 @@ static int count_windows (register struct window *window) { register int count = 1; - if (!NILP (WVAR (window, next))) - count += count_windows (XWINDOW (WVAR (window, next))); - if (!NILP (WVAR (window, vchild))) - count += count_windows (XWINDOW (WVAR (window, vchild))); - if (!NILP (WVAR (window, hchild))) - count += count_windows (XWINDOW (WVAR (window, hchild))); + if (!NILP (window->next)) + count += count_windows (XWINDOW (window->next)); + if (!NILP (window->vchild)) + count += count_windows (XWINDOW (window->vchild)); + if (!NILP (window->hchild)) + count += count_windows (XWINDOW (window->hchild)); return count; } @@ -5805,14 +5801,14 @@ get_leaf_windows (struct window *w, struct window **flat, int i) { while (w) { - if (!NILP (WVAR (w, hchild))) - i = get_leaf_windows (XWINDOW (WVAR (w, hchild)), flat, i); - else if (!NILP (WVAR (w, vchild))) - i = get_leaf_windows (XWINDOW (WVAR (w, vchild)), flat, i); + if (!NILP (w->hchild)) + i = get_leaf_windows (XWINDOW (w->hchild), flat, i); + else if (!NILP (w->vchild)) + i = get_leaf_windows (XWINDOW (w->vchild), flat, i); else flat[i++] = w; - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } return i; @@ -5865,32 +5861,32 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) register struct window *w; register Lisp_Object tem, pers, par; - for (;!NILP (window); window = WVAR (w, next)) + for (;!NILP (window); window = w->next) { p = SAVED_WINDOW_N (vector, i); w = XWINDOW (window); - XSETFASTINT (WVAR (w, temslot), i); i++; + WSET (w, temslot, make_number (i)); i++; p->window = window; - p->buffer = WVAR (w, buffer); - p->left_col = WVAR (w, left_col); - p->top_line = WVAR (w, top_line); - p->total_cols = WVAR (w, total_cols); - p->total_lines = WVAR (w, total_lines); - p->normal_cols = WVAR (w, normal_cols); - p->normal_lines = WVAR (w, normal_lines); + p->buffer = w->buffer; + p->left_col = w->left_col; + p->top_line = w->top_line; + p->total_cols = w->total_cols; + p->total_lines = w->total_lines; + p->normal_cols = w->normal_cols; + p->normal_lines = w->normal_lines; XSETFASTINT (p->hscroll, w->hscroll); XSETFASTINT (p->min_hscroll, w->min_hscroll); - p->display_table = WVAR (w, display_table); - p->left_margin_cols = WVAR (w, left_margin_cols); - p->right_margin_cols = WVAR (w, right_margin_cols); - p->left_fringe_width = WVAR (w, left_fringe_width); - p->right_fringe_width = WVAR (w, right_fringe_width); + p->display_table = w->display_table; + p->left_margin_cols = w->left_margin_cols; + p->right_margin_cols = w->right_margin_cols; + p->left_fringe_width = w->left_fringe_width; + p->right_fringe_width = w->right_fringe_width; p->fringes_outside_margins = w->fringes_outside_margins ? Qt : Qnil; - p->scroll_bar_width = WVAR (w, scroll_bar_width); - p->vertical_scroll_bar_type = WVAR (w, vertical_scroll_bar_type); - p->dedicated = WVAR (w, dedicated); - p->combination_limit = WVAR (w, combination_limit); + p->scroll_bar_width = w->scroll_bar_width; + p->vertical_scroll_bar_type = w->vertical_scroll_bar_type; + p->dedicated = w->dedicated; + p->combination_limit = w->combination_limit; p->window_parameters = Qnil; if (!NILP (Vwindow_persistent_parameters)) @@ -5923,7 +5919,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) /* Save values for persistent window parameters. */ if (CONSP (pers) && !NILP (XCDR (pers))) { - par = Fassq (XCAR (pers), WVAR (w, window_parameters)); + par = Fassq (XCAR (pers), w->window_parameters); if (NILP (par)) /* If the window has no value for the parameter, make one. */ @@ -5939,24 +5935,24 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) } } - if (!NILP (WVAR (w, buffer))) + if (!NILP (w->buffer)) { /* Save w's value of point in the window configuration. If w is the selected window, then get the value of point from the buffer; pointm is garbage in the selected window. */ if (EQ (window, selected_window)) - p->pointm = build_marker (XBUFFER (WVAR (w, buffer)), - BUF_PT (XBUFFER (WVAR (w, buffer))), - BUF_PT_BYTE (XBUFFER (WVAR (w, buffer)))); + p->pointm = build_marker (XBUFFER (w->buffer), + BUF_PT (XBUFFER (w->buffer)), + BUF_PT_BYTE (XBUFFER (w->buffer))); else - p->pointm = Fcopy_marker (WVAR (w, pointm), Qnil); + p->pointm = Fcopy_marker (w->pointm, Qnil); XMARKER (p->pointm)->insertion_type = !NILP (Vwindow_point_insertion_type); - p->start = Fcopy_marker (WVAR (w, start), Qnil); + p->start = Fcopy_marker (w->start, Qnil); p->start_at_line_beg = w->start_at_line_beg ? Qt : Qnil; - tem = BVAR (XBUFFER (WVAR (w, buffer)), mark); + tem = BVAR (XBUFFER (w->buffer), mark); p->mark = Fcopy_marker (tem, Qnil); } else @@ -5967,20 +5963,20 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) p->start_at_line_beg = Qnil; } - if (NILP (WVAR (w, parent))) + if (NILP (w->parent)) p->parent = Qnil; else - p->parent = WVAR (XWINDOW (WVAR (w, parent)), temslot); + p->parent = XWINDOW (w->parent)->temslot; - if (NILP (WVAR (w, prev))) + if (NILP (w->prev)) p->prev = Qnil; else - p->prev = WVAR (XWINDOW (WVAR (w, prev)), temslot); + p->prev = XWINDOW (w->prev)->temslot; - if (!NILP (WVAR (w, vchild))) - i = save_window_save (WVAR (w, vchild), vector, i); - if (!NILP (WVAR (w, hchild))) - i = save_window_save (WVAR (w, hchild), vector, i); + if (!NILP (w->vchild)) + i = save_window_save (w->vchild, vector, i); + if (!NILP (w->hchild)) + i = save_window_save (w->hchild, vector, i); } return i; @@ -6069,11 +6065,11 @@ means no margin. */) right_width = Qnil; } - if (!EQ (WVAR (w, left_margin_cols), left_width) - || !EQ (WVAR (w, right_margin_cols), right_width)) + if (!EQ (w->left_margin_cols, left_width) + || !EQ (w->right_margin_cols, right_width)) { - WVAR (w, left_margin_cols) = left_width; - WVAR (w, right_margin_cols) = right_width; + WSET (w, left_margin_cols, left_width); + WSET (w, right_margin_cols, right_width); adjust_window_margins (w); @@ -6095,7 +6091,7 @@ as nil. */) (Lisp_Object window) { struct window *w = decode_window (window); - return Fcons (WVAR (w, left_margin_cols), WVAR (w, right_margin_cols)); + return Fcons (w->left_margin_cols, w->right_margin_cols); } @@ -6129,18 +6125,18 @@ display marginal areas and the text area. */) /* Do nothing on a tty. */ if (FRAME_WINDOW_P (WINDOW_XFRAME (w)) - && (!EQ (WVAR (w, left_fringe_width), left_width) - || !EQ (WVAR (w, right_fringe_width), right_width) + && (!EQ (w->left_fringe_width, left_width) + || !EQ (w->right_fringe_width, right_width) || w->fringes_outside_margins != outside)) { - WVAR (w, left_fringe_width) = left_width; - WVAR (w, right_fringe_width) = right_width; + WSET (w, left_fringe_width, left_width); + WSET (w, right_fringe_width, right_width); w->fringes_outside_margins = outside; adjust_window_margins (w); clear_glyph_matrix (w->current_matrix); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); ++windows_or_buffers_changed; adjust_glyphs (XFRAME (WINDOW_FRAME (w))); @@ -6200,16 +6196,16 @@ Fourth parameter HORIZONTAL-TYPE is currently unused. */) || EQ (vertical_type, Qt))) error ("Invalid type of vertical scroll bar"); - if (!EQ (WVAR (w, scroll_bar_width), width) - || !EQ (WVAR (w, vertical_scroll_bar_type), vertical_type)) + if (!EQ (w->scroll_bar_width, width) + || !EQ (w->vertical_scroll_bar_type, vertical_type)) { - WVAR (w, scroll_bar_width) = width; - WVAR (w, vertical_scroll_bar_type) = vertical_type; + WSET (w, scroll_bar_width, width); + WSET (w, vertical_scroll_bar_type, vertical_type); adjust_window_margins (w); clear_glyph_matrix (w->current_matrix); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); ++windows_or_buffers_changed; adjust_glyphs (XFRAME (WINDOW_FRAME (w))); @@ -6233,7 +6229,7 @@ value. */) ? WINDOW_CONFIG_SCROLL_BAR_WIDTH (w) : WINDOW_SCROLL_BAR_AREA_WIDTH (w))), Fcons (make_number (WINDOW_SCROLL_BAR_COLS (w)), - Fcons (WVAR (w, vertical_scroll_bar_type), + Fcons (w->vertical_scroll_bar_type, Fcons (Qnil, Qnil)))); } @@ -6259,7 +6255,7 @@ optional second arg PIXELS-P means value is measured in pixels. */) else CHECK_WINDOW (window); w = XWINDOW (window); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); if (FRAME_WINDOW_P (f)) result = (NILP (pixels_p) @@ -6293,7 +6289,7 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) CHECK_NUMBER_OR_FLOAT (vscroll); w = XWINDOW (window); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); if (FRAME_WINDOW_P (f)) { @@ -6312,7 +6308,7 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */) adjust_glyphs (f); /* Prevent redisplay shortcuts. */ - XBUFFER (WVAR (w, buffer))->prevent_redisplay_optimizations_p = 1; + XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; } } @@ -6346,14 +6342,14 @@ foreach_window_1 (struct window *w, int (*fn) (struct window *, void *), void *u for (cont = 1; w && cont;) { - if (!NILP (WVAR (w, hchild))) - cont = foreach_window_1 (XWINDOW (WVAR (w, hchild)), fn, user_data); - else if (!NILP (WVAR (w, vchild))) - cont = foreach_window_1 (XWINDOW (WVAR (w, vchild)), fn, user_data); + if (!NILP (w->hchild)) + cont = foreach_window_1 (XWINDOW (w->hchild), fn, user_data); + else if (!NILP (w->vchild)) + cont = foreach_window_1 (XWINDOW (w->vchild), fn, user_data); else cont = fn (w, user_data); - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } return cont; @@ -6495,8 +6491,8 @@ init_window_once (void) struct frame *f = make_initial_frame (); XSETFRAME (selected_frame, f); Vterminal_frame = selected_frame; - minibuf_window = FVAR (f, minibuffer_window); - selected_window = FVAR (f, selected_window); + minibuf_window = f->minibuffer_window; + selected_window = f->selected_window; last_nonminibuf_frame = f; window_initialized = 1; diff --git a/src/window.h b/src/window.h index ece58d2cf97..3e6f4f82b0a 100644 --- a/src/window.h +++ b/src/window.h @@ -86,9 +86,9 @@ struct cursor_pos int hpos, vpos; }; -/* Most code should use this macro to access Lisp fields in struct window. */ +/* Most code should use this macro to set Lisp fields in struct window. */ -#define WVAR(w, field) ((w)->INTERNAL_FIELD (field)) +#define WSET(w, field, value) ((w)->field = (value)) struct window { @@ -96,140 +96,140 @@ struct window struct vectorlike_header header; /* The frame this window is on. */ - Lisp_Object INTERNAL_FIELD (frame); + Lisp_Object frame; /* Following (to right or down) and preceding (to left or up) child at same level of tree. */ - Lisp_Object INTERNAL_FIELD (next); - Lisp_Object INTERNAL_FIELD (prev); + Lisp_Object next; + Lisp_Object prev; /* First child of this window: vchild is used if this is a vertical combination, hchild if this is a horizontal combination. Of the fields vchild, hchild and buffer, one and only one is non-nil unless the window is dead. */ - Lisp_Object INTERNAL_FIELD (hchild); - Lisp_Object INTERNAL_FIELD (vchild); + Lisp_Object hchild; + Lisp_Object vchild; /* The window this one is a child of. */ - Lisp_Object INTERNAL_FIELD (parent); + Lisp_Object parent; /* The upper left corner coordinates of this window, as integers relative to upper left corner of frame = 0, 0. */ - Lisp_Object INTERNAL_FIELD (left_col); - Lisp_Object INTERNAL_FIELD (top_line); + Lisp_Object left_col; + Lisp_Object top_line; /* The size of the window. */ - Lisp_Object INTERNAL_FIELD (total_lines); - Lisp_Object INTERNAL_FIELD (total_cols); + Lisp_Object total_lines; + Lisp_Object total_cols; /* The normal size of the window. */ - Lisp_Object INTERNAL_FIELD (normal_lines); - Lisp_Object INTERNAL_FIELD (normal_cols); + Lisp_Object normal_lines; + Lisp_Object normal_cols; /* New sizes of the window. */ - Lisp_Object INTERNAL_FIELD (new_total); - Lisp_Object INTERNAL_FIELD (new_normal); + Lisp_Object new_total; + Lisp_Object new_normal; /* The buffer displayed in this window. Of the fields vchild, hchild and buffer, one and only one is non-nil unless the window is dead. */ - Lisp_Object INTERNAL_FIELD (buffer); + Lisp_Object buffer; /* A marker pointing to where in the text to start displaying. BIDI Note: This is the _logical-order_ start, i.e. the smallest buffer position visible in the window, not necessarily the character displayed in the top left corner of the window. */ - Lisp_Object INTERNAL_FIELD (start); + Lisp_Object start; /* A marker pointing to where in the text point is in this window, used only when the window is not selected. This exists so that when multiple windows show one buffer each one can have its own value of point. */ - Lisp_Object INTERNAL_FIELD (pointm); + Lisp_Object pointm; /* No permanent meaning; used by save-window-excursion's bookkeeping. */ - Lisp_Object INTERNAL_FIELD (temslot); + Lisp_Object temslot; /* This window's vertical scroll bar. This field is only for use by the window-system-dependent code which implements the scroll bars; it can store anything it likes here. If this window is newly created and we haven't displayed a scroll bar in it yet, or if the frame doesn't have any scroll bars, this is nil. */ - Lisp_Object INTERNAL_FIELD (vertical_scroll_bar); + Lisp_Object vertical_scroll_bar; /* Width of left and right marginal areas. A value of nil means no margin. */ - Lisp_Object INTERNAL_FIELD (left_margin_cols); - Lisp_Object INTERNAL_FIELD (right_margin_cols); + Lisp_Object left_margin_cols; + Lisp_Object right_margin_cols; /* Width of left and right fringes. A value of nil or t means use frame values. */ - Lisp_Object INTERNAL_FIELD (left_fringe_width); - Lisp_Object INTERNAL_FIELD (right_fringe_width); + Lisp_Object left_fringe_width; + Lisp_Object right_fringe_width; /* Pixel width of scroll bars. A value of nil or t means use frame values. */ - Lisp_Object INTERNAL_FIELD (scroll_bar_width); + Lisp_Object scroll_bar_width; /* Type of vertical scroll bar. A value of nil means no scroll bar. A value of t means use frame value. */ - Lisp_Object INTERNAL_FIELD (vertical_scroll_bar_type); + Lisp_Object vertical_scroll_bar_type; /* Z - the buffer position of the last glyph in the current matrix of W. Only valid if WINDOW_END_VALID is not nil. */ - Lisp_Object INTERNAL_FIELD (window_end_pos); + Lisp_Object window_end_pos; /* Glyph matrix row of the last glyph in the current matrix of W. Only valid if WINDOW_END_VALID is not nil. */ - Lisp_Object INTERNAL_FIELD (window_end_vpos); + Lisp_Object window_end_vpos; /* t if window_end_pos is truly valid. This is nil if nontrivial redisplay is preempted since in that case the frame image that window_end_pos did not get onto the frame. */ - Lisp_Object INTERNAL_FIELD (window_end_valid); + Lisp_Object window_end_valid; /* Display-table to use for displaying chars in this window. Nil means use the buffer's own display-table. */ - Lisp_Object INTERNAL_FIELD (display_table); + Lisp_Object display_table; /* Non-nil usually means window is marked as dedicated. Note Lisp code may set this to something beyond Qnil and Qt, so bitfield can't be used here. */ - Lisp_Object INTERNAL_FIELD (dedicated); + Lisp_Object dedicated; /* Line number and position of a line somewhere above the top of the screen. If this field is nil, it means we don't have a base line. */ - Lisp_Object INTERNAL_FIELD (base_line_number); + Lisp_Object base_line_number; /* If this field is nil, it means we don't have a base line. If it is a buffer, it means don't display the line number as long as the window shows that buffer. */ - Lisp_Object INTERNAL_FIELD (base_line_pos); + Lisp_Object base_line_pos; /* If we have highlighted the region (or any part of it), this is the mark position that we used, as an integer. */ - Lisp_Object INTERNAL_FIELD (region_showing); + Lisp_Object region_showing; /* The column number currently displayed in this window's mode line, or nil if column numbers are not being displayed. */ - Lisp_Object INTERNAL_FIELD (column_number_displayed); + Lisp_Object column_number_displayed; /* If redisplay in this window goes beyond this buffer position, must run the redisplay-end-trigger-hook. */ - Lisp_Object INTERNAL_FIELD (redisplay_end_trigger); + Lisp_Object redisplay_end_trigger; /* t means this window's child windows are not (re-)combined. */ - Lisp_Object INTERNAL_FIELD (combination_limit); + Lisp_Object combination_limit; /* Alist of triples listing buffers previously shown in this window. */ - Lisp_Object INTERNAL_FIELD (prev_buffers); + Lisp_Object prev_buffers; /* List of buffers re-shown in this window. */ - Lisp_Object INTERNAL_FIELD (next_buffers); + Lisp_Object next_buffers; /* An alist with parameters. */ - Lisp_Object INTERNAL_FIELD (window_parameters); + Lisp_Object window_parameters; /* No Lisp data may follow below this point without changing mark_object in alloc.c. The member current_matrix must be the @@ -396,13 +396,13 @@ struct window This includes scroll bars and fringes. */ #define WINDOW_TOTAL_COLS(W) \ - (XFASTINT (WVAR (W, total_cols))) + (XFASTINT (W->total_cols)) /* Return the height of window W in canonical line units. This includes header and mode lines, if any. */ #define WINDOW_TOTAL_LINES(W) \ - (XFASTINT (WVAR (W, total_lines))) + (XFASTINT (W->total_lines)) /* Return the total pixel width of window W. */ @@ -430,7 +430,7 @@ struct window This includes a left-hand scroll bar, if any. */ #define WINDOW_LEFT_EDGE_COL(W) \ - (XFASTINT (WVAR (W, left_col))) + (XFASTINT (W->left_col)) /* Return the canonical frame column before which window W ends. This includes a right-hand scroll bar, if any. */ @@ -442,7 +442,7 @@ struct window This includes a header line, if any. */ #define WINDOW_TOP_EDGE_LINE(W) \ - (XFASTINT (WVAR (W, top_line))) + (XFASTINT (W->top_line)) /* Return the canonical frame line before which window W ends. This includes a mode line, if any. */ @@ -468,14 +468,14 @@ struct window /* 1 if W is a menu bar window. */ #define WINDOW_MENU_BAR_P(W) \ - (WINDOWP (FVAR (WINDOW_XFRAME (W), menu_bar_window)) \ - && (W) == XWINDOW (FVAR (WINDOW_XFRAME (W), menu_bar_window))) + (WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \ + && (W) == XWINDOW (WINDOW_XFRAME (W)->menu_bar_window)) /* 1 if W is a tool bar window. */ #define WINDOW_TOOL_BAR_P(W) \ - (WINDOWP (FVAR (WINDOW_XFRAME (W), tool_bar_window)) \ - && (W) == XWINDOW (FVAR (WINDOW_XFRAME (W), tool_bar_window))) + (WINDOWP (WINDOW_XFRAME (W)->tool_bar_window) \ + && (W) == XWINDOW (WINDOW_XFRAME (W)->tool_bar_window)) /* Return the frame y-position at which window W starts. This includes a header line, if any. */ @@ -546,32 +546,32 @@ struct window /* Width of left margin area in columns. */ -#define WINDOW_LEFT_MARGIN_COLS(W) \ - (NILP (WVAR (W, left_margin_cols)) \ - ? 0 \ - : XINT (WVAR (W, left_margin_cols))) +#define WINDOW_LEFT_MARGIN_COLS(W) \ + (NILP (W->left_margin_cols) \ + ? 0 \ + : XINT (W->left_margin_cols)) /* Width of right marginal area in columns. */ -#define WINDOW_RIGHT_MARGIN_COLS(W) \ - (NILP (WVAR (W, right_margin_cols)) \ - ? 0 \ - : XINT (WVAR (W, right_margin_cols))) +#define WINDOW_RIGHT_MARGIN_COLS(W) \ + (NILP (W->right_margin_cols) \ + ? 0 \ + : XINT (W->right_margin_cols)) /* Width of left margin area in pixels. */ -#define WINDOW_LEFT_MARGIN_WIDTH(W) \ - (NILP (WVAR (W, left_margin_cols)) \ - ? 0 \ - : (XINT (WVAR (W, left_margin_cols)) \ +#define WINDOW_LEFT_MARGIN_WIDTH(W) \ + (NILP (W->left_margin_cols) \ + ? 0 \ + : (XINT (W->left_margin_cols) \ * WINDOW_FRAME_COLUMN_WIDTH (W))) /* Width of right marginal area in pixels. */ -#define WINDOW_RIGHT_MARGIN_WIDTH(W) \ - (NILP (WVAR (W, right_margin_cols)) \ - ? 0 \ - : (XINT (WVAR (W, right_margin_cols)) \ +#define WINDOW_RIGHT_MARGIN_WIDTH(W) \ + (NILP (W->right_margin_cols) \ + ? 0 \ + : (XINT (W->right_margin_cols) \ * WINDOW_FRAME_COLUMN_WIDTH (W))) /* Total width of fringes reserved for drawing truncation bitmaps, @@ -580,37 +580,37 @@ struct window sizes aren't pixel values. If it weren't the case, we wouldn't be able to split windows horizontally nicely. */ -#define WINDOW_FRINGE_COLS(W) \ - ((INTEGERP (WVAR (W, left_fringe_width)) \ - || INTEGERP (WVAR (W, right_fringe_width))) \ - ? ((WINDOW_LEFT_FRINGE_WIDTH (W) \ - + WINDOW_RIGHT_FRINGE_WIDTH (W) \ - + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ - / WINDOW_FRAME_COLUMN_WIDTH (W)) \ +#define WINDOW_FRINGE_COLS(W) \ + ((INTEGERP (W->left_fringe_width) \ + || INTEGERP (W->right_fringe_width)) \ + ? ((WINDOW_LEFT_FRINGE_WIDTH (W) \ + + WINDOW_RIGHT_FRINGE_WIDTH (W) \ + + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ + / WINDOW_FRAME_COLUMN_WIDTH (W)) \ : FRAME_FRINGE_COLS (WINDOW_XFRAME (W))) /* Column-width of the left and right fringe. */ -#define WINDOW_LEFT_FRINGE_COLS(W) \ - ((WINDOW_LEFT_FRINGE_WIDTH ((W)) \ - + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ +#define WINDOW_LEFT_FRINGE_COLS(W) \ + ((WINDOW_LEFT_FRINGE_WIDTH ((W)) \ + + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ / WINDOW_FRAME_COLUMN_WIDTH (W)) -#define WINDOW_RIGHT_FRINGE_COLS(W) \ - ((WINDOW_RIGHT_FRINGE_WIDTH ((W)) \ - + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ +#define WINDOW_RIGHT_FRINGE_COLS(W) \ + ((WINDOW_RIGHT_FRINGE_WIDTH ((W)) \ + + WINDOW_FRAME_COLUMN_WIDTH (W) - 1) \ / WINDOW_FRAME_COLUMN_WIDTH (W)) /* Pixel-width of the left and right fringe. */ #define WINDOW_LEFT_FRINGE_WIDTH(W) \ - (INTEGERP (WVAR (W, left_fringe_width)) \ - ? XFASTINT (WVAR (W, left_fringe_width)) \ + (INTEGERP (W->left_fringe_width) \ + ? XFASTINT (W->left_fringe_width) \ : FRAME_LEFT_FRINGE_WIDTH (WINDOW_XFRAME (W))) #define WINDOW_RIGHT_FRINGE_WIDTH(W) \ - (INTEGERP (WVAR (W, right_fringe_width)) \ - ? XFASTINT (WVAR (W, right_fringe_width)) \ + (INTEGERP (W->right_fringe_width) \ + ? XFASTINT (W->right_fringe_width) \ : FRAME_RIGHT_FRINGE_WIDTH (WINDOW_XFRAME (W))) /* Total width of fringes in pixels. */ @@ -627,36 +627,36 @@ struct window and which side they are on. */ #define WINDOW_VERTICAL_SCROLL_BAR_TYPE(w) \ - (EQ (WVAR (w, vertical_scroll_bar_type), Qt) \ + (EQ (w->vertical_scroll_bar_type, Qt) \ ? FRAME_VERTICAL_SCROLL_BAR_TYPE (WINDOW_XFRAME (w)) \ - : EQ (WVAR (w, vertical_scroll_bar_type), Qleft) \ + : EQ (w->vertical_scroll_bar_type, Qleft) \ ? vertical_scroll_bar_left \ - : EQ (WVAR (w, vertical_scroll_bar_type), Qright) \ + : EQ (w->vertical_scroll_bar_type, Qright) \ ? vertical_scroll_bar_right \ : vertical_scroll_bar_none) \ #define WINDOW_HAS_VERTICAL_SCROLL_BAR(w) \ - (EQ (WVAR (w, vertical_scroll_bar_type), Qt) \ + (EQ (w->vertical_scroll_bar_type, Qt) \ ? FRAME_HAS_VERTICAL_SCROLL_BARS (WINDOW_XFRAME (w)) \ - : !NILP (WVAR (w, vertical_scroll_bar_type))) + : !NILP (w->vertical_scroll_bar_type)) #define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT(w) \ - (EQ (WVAR (w, vertical_scroll_bar_type), Qt) \ + (EQ (w->vertical_scroll_bar_type, Qt) \ ? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT (WINDOW_XFRAME (w)) \ - : EQ (WVAR (w, vertical_scroll_bar_type), Qleft)) + : EQ (w->vertical_scroll_bar_type, Qleft)) -#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT(w) \ - (EQ (WVAR (w, vertical_scroll_bar_type), Qt) \ - ? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (WINDOW_XFRAME (w))\ - : EQ (WVAR (w, vertical_scroll_bar_type), Qright)) +#define WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT(w) \ + (EQ (w->vertical_scroll_bar_type, Qt) \ + ? FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT (WINDOW_XFRAME (w)) \ + : EQ (w->vertical_scroll_bar_type, Qright)) /* Width that a scroll bar in window W should have, if there is one. Measured in pixels. If scroll bars are turned off, this is still nonzero. */ #define WINDOW_CONFIG_SCROLL_BAR_WIDTH(w) \ - (INTEGERP (WVAR (w, scroll_bar_width)) \ - ? XFASTINT (WVAR (w, scroll_bar_width)) \ + (INTEGERP (w->scroll_bar_width) \ + ? XFASTINT (w->scroll_bar_width) \ : FRAME_CONFIG_SCROLL_BAR_WIDTH (WINDOW_XFRAME (w))) /* Width that a scroll bar in window W should have, if there is one. @@ -664,8 +664,8 @@ struct window this is still nonzero. */ #define WINDOW_CONFIG_SCROLL_BAR_COLS(w) \ - (INTEGERP (WVAR (w, scroll_bar_width)) \ - ? ((XFASTINT (WVAR (w, scroll_bar_width)) \ + (INTEGERP (w->scroll_bar_width) \ + ? ((XFASTINT (w->scroll_bar_width) \ + WINDOW_FRAME_COLUMN_WIDTH (w) - 1) \ / WINDOW_FRAME_COLUMN_WIDTH (w)) \ : FRAME_CONFIG_SCROLL_BAR_COLS (WINDOW_XFRAME (w))) @@ -675,14 +675,14 @@ struct window the right in this frame, or there are no scroll bars, value is 0. */ #define WINDOW_LEFT_SCROLL_BAR_COLS(w) \ - (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \ + (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \ ? (WINDOW_CONFIG_SCROLL_BAR_COLS (w)) \ : 0) /* Width of a left scroll bar area in window W , measured in pixels. */ -#define WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH(w) \ - (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \ +#define WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH(w) \ + (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w) \ ? (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)) \ : 0) @@ -691,7 +691,7 @@ struct window the left in this frame, or there are no scroll bars, value is 0. */ #define WINDOW_RIGHT_SCROLL_BAR_COLS(w) \ - (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w) \ + (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w) \ ? WINDOW_CONFIG_SCROLL_BAR_COLS (w) \ : 0) @@ -713,7 +713,7 @@ struct window /* Width of a left scroll bar area in window W , measured in pixels. */ #define WINDOW_SCROLL_BAR_AREA_WIDTH(w) \ - (WINDOW_HAS_VERTICAL_SCROLL_BAR (w) \ + (WINDOW_HAS_VERTICAL_SCROLL_BAR (w) \ ? (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * WINDOW_FRAME_COLUMN_WIDTH (w)) \ : 0) @@ -734,7 +734,7 @@ struct window ? CURRENT_MODE_LINE_HEIGHT (W) \ : 0) -#define WINDOW_MODE_LINE_LINES(W) \ +#define WINDOW_MODE_LINE_LINES(W) \ (!! WINDOW_WANTS_MODELINE_P ((W))) /* Height in pixels, and in lines, of the header line. @@ -745,7 +745,7 @@ struct window ? CURRENT_HEADER_LINE_HEIGHT (W) \ : 0) -#define WINDOW_HEADER_LINE_LINES(W) \ +#define WINDOW_HEADER_LINE_LINES(W) \ (!! WINDOW_WANTS_HEADER_LINE_P ((W))) /* Pixel height of window W without mode line. */ @@ -756,36 +756,36 @@ struct window /* Pixel height of window W without mode and header line. */ -#define WINDOW_BOX_TEXT_HEIGHT(W) \ - (WINDOW_TOTAL_HEIGHT ((W)) \ - - WINDOW_MODE_LINE_HEIGHT ((W)) \ +#define WINDOW_BOX_TEXT_HEIGHT(W) \ + (WINDOW_TOTAL_HEIGHT ((W)) \ + - WINDOW_MODE_LINE_HEIGHT ((W)) \ - WINDOW_HEADER_LINE_HEIGHT ((W))) /* Convert window W relative pixel X to frame pixel coordinates. */ -#define WINDOW_TO_FRAME_PIXEL_X(W, X) \ +#define WINDOW_TO_FRAME_PIXEL_X(W, X) \ ((X) + WINDOW_BOX_LEFT_EDGE_X ((W))) /* Convert window W relative pixel Y to frame pixel coordinates. */ -#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \ +#define WINDOW_TO_FRAME_PIXEL_Y(W, Y) \ ((Y) + WINDOW_TOP_EDGE_Y ((W))) /* Convert frame relative pixel X to window relative pixel X. */ -#define FRAME_TO_WINDOW_PIXEL_X(W, X) \ +#define FRAME_TO_WINDOW_PIXEL_X(W, X) \ ((X) - WINDOW_BOX_LEFT_EDGE_X ((W))) /* Convert frame relative pixel Y to window relative pixel Y. */ -#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \ +#define FRAME_TO_WINDOW_PIXEL_Y(W, Y) \ ((Y) - WINDOW_TOP_EDGE_Y ((W))) /* Convert a text area relative x-position in window W to frame X pixel coordinates. */ -#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \ +#define WINDOW_TEXT_TO_FRAME_PIXEL_X(W, X) \ (window_box_left ((W), TEXT_AREA) + (X)) /* This is the window in which the terminal's cursor should @@ -887,9 +887,8 @@ struct glyph *get_phys_cursor_glyph (struct window *w); /* Value is non-zero if WINDOW is a live window. */ -#define WINDOW_LIVE_P(WINDOW) \ - (WINDOWP ((WINDOW)) && !NILP (WVAR (XWINDOW ((WINDOW)), buffer))) - +#define WINDOW_LIVE_P(WINDOW) \ + (WINDOWP (WINDOW) && !NILP (XWINDOW (WINDOW)->buffer)) /* These used to be in lisp.h. */ diff --git a/src/xdisp.c b/src/xdisp.c index 11a9eb5df93..3b35d252508 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -840,7 +840,6 @@ static int string_char_and_length (const unsigned char *, int *); static struct text_pos display_prop_end (struct it *, Lisp_Object, struct text_pos); static int compute_window_start_on_continuation_line (struct window *); -static Lisp_Object safe_eval_handler (Lisp_Object); static void insert_left_trunc_glyphs (struct it *); static struct glyph_row *get_overlay_arrow_glyph_row (struct window *, Lisp_Object); @@ -989,7 +988,7 @@ window_text_bottom_y (struct window *w) int window_box_width (struct window *w, int area) { - int cols = XFASTINT (WVAR (w, total_cols)); + int cols = XFASTINT (w->total_cols); int pixels = 0; if (!w->pseudo_window_p) @@ -998,22 +997,22 @@ window_box_width (struct window *w, int area) if (area == TEXT_AREA) { - if (INTEGERP (WVAR (w, left_margin_cols))) - cols -= XFASTINT (WVAR (w, left_margin_cols)); - if (INTEGERP (WVAR (w, right_margin_cols))) - cols -= XFASTINT (WVAR (w, right_margin_cols)); + if (INTEGERP (w->left_margin_cols)) + cols -= XFASTINT (w->left_margin_cols); + if (INTEGERP (w->right_margin_cols)) + cols -= XFASTINT (w->right_margin_cols); pixels = -WINDOW_TOTAL_FRINGE_WIDTH (w); } else if (area == LEFT_MARGIN_AREA) { - cols = (INTEGERP (WVAR (w, left_margin_cols)) - ? XFASTINT (WVAR (w, left_margin_cols)) : 0); + cols = (INTEGERP (w->left_margin_cols) + ? XFASTINT (w->left_margin_cols) : 0); pixels = 0; } else if (area == RIGHT_MARGIN_AREA) { - cols = (INTEGERP (WVAR (w, right_margin_cols)) - ? XFASTINT (WVAR (w, right_margin_cols)) : 0); + cols = (INTEGERP (w->right_margin_cols) + ? XFASTINT (w->right_margin_cols) : 0); pixels = 0; } } @@ -1028,7 +1027,7 @@ window_box_width (struct window *w, int area) int window_box_height (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int height = WINDOW_TOTAL_HEIGHT (w); eassert (height >= 0); @@ -1117,7 +1116,7 @@ window_box_right_offset (struct window *w, int area) int window_box_left (struct window *w, int area) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int x; if (w->pseudo_window_p) @@ -1293,13 +1292,13 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, if (FRAME_INITIAL_P (XFRAME (WINDOW_FRAME (w)))) return visible_p; - if (XBUFFER (WVAR (w, buffer)) != current_buffer) + if (XBUFFER (w->buffer) != current_buffer) { old_buffer = current_buffer; - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + set_buffer_internal_1 (XBUFFER (w->buffer)); } - SET_TEXT_POS_FROM_MARKER (top, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (top, w->start); /* Scrolling a minibuffer window via scroll bar when the echo area shows long text sometimes resets the minibuffer contents behind our backs. */ @@ -1918,7 +1917,7 @@ frame_to_window_pixel_xy (struct window *w, int *x, int *y) { /* A pseudo-window is always full-width, and starts at the left edge of the frame, plus a frame border. */ - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); *x -= FRAME_INTERNAL_BORDER_WIDTH (f); *y = FRAME_TO_WINDOW_PIXEL_Y (w, *y); } @@ -2402,9 +2401,10 @@ remember_mouse_glyph (struct frame *f, int gx, int gy, NativeRectangle *rect) /* Error handler for safe_eval and safe_call. */ static Lisp_Object -safe_eval_handler (Lisp_Object arg) +safe_eval_handler (Lisp_Object arg, ptrdiff_t nargs, Lisp_Object *args) { - add_to_log ("Error during redisplay: %S", arg, Qnil); + add_to_log ("Error during redisplay: %S signalled %S", + Flist (nargs, args), arg); return Qnil; } @@ -2425,7 +2425,7 @@ safe_call (ptrdiff_t nargs, Lisp_Object func, ...) ptrdiff_t i; ptrdiff_t count = SPECPDL_INDEX (); struct gcpro gcpro1; - Lisp_Object *args = alloca (nargs * sizeof (Lisp_Object)); + Lisp_Object *args = alloca (nargs * word_size); args[0] = func; va_start (ap, func); @@ -2527,11 +2527,11 @@ static void check_window_end (struct window *w) { if (!MINI_WINDOW_P (w) - && !NILP (WVAR (w, window_end_valid))) + && !NILP (w->window_end_valid)) { struct glyph_row *row; eassert ((row = MATRIX_ROW (w->current_matrix, - XFASTINT (WVAR (w, window_end_vpos))), + XFASTINT (w->window_end_vpos)), !row->enabled_p || MATRIX_ROW_DISPLAYS_TEXT_P (row) || MATRIX_ROW_VPOS (row, w->current_matrix) == 0)); @@ -2597,7 +2597,7 @@ init_iterator (struct it *it, struct window *w, /* Perhaps remap BASE_FACE_ID to a user-specified alternative. */ if (! NILP (Vface_remapping_alist)) remapped_base_face_id - = lookup_basic_face (XFRAME (WVAR (w, frame)), base_face_id); + = lookup_basic_face (XFRAME (w->frame), base_face_id); /* Use one of the mode line rows of W's desired matrix if appropriate. */ @@ -2625,7 +2625,7 @@ init_iterator (struct it *it, struct window *w, /* The window in which we iterate over current_buffer: */ XSETWINDOW (it->window, w); it->w = w; - it->f = XFRAME (WVAR (w, frame)); + it->f = XFRAME (w->frame); it->cmp_it.id = -1; @@ -2665,9 +2665,9 @@ init_iterator (struct it *it, struct window *w, is invisible. >0 means lines indented more than this value are invisible. */ it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) - ? clip_to_bounds - (-1, XINT (BVAR (current_buffer, selective_display)), - PTRDIFF_MAX) + ? (clip_to_bounds + (-1, XINT (BVAR (current_buffer, selective_display)), + PTRDIFF_MAX)) : (!NILP (BVAR (current_buffer, selective_display)) ? -1 : 0)); it->selective_display_ellipsis_p @@ -2709,13 +2709,13 @@ init_iterator (struct it *it, struct window *w, /* Get the position at which the redisplay_end_trigger hook should be run, if it is to be run at all. */ - if (MARKERP (WVAR (w, redisplay_end_trigger)) - && XMARKER (WVAR (w, redisplay_end_trigger))->buffer != 0) + if (MARKERP (w->redisplay_end_trigger) + && XMARKER (w->redisplay_end_trigger)->buffer != 0) it->redisplay_end_trigger_charpos - = marker_position (WVAR (w, redisplay_end_trigger)); - else if (INTEGERP (WVAR (w, redisplay_end_trigger))) + = marker_position (w->redisplay_end_trigger); + else if (INTEGERP (w->redisplay_end_trigger)) it->redisplay_end_trigger_charpos = - clip_to_bounds (PTRDIFF_MIN, XINT (WVAR (w, redisplay_end_trigger)), PTRDIFF_MAX); + clip_to_bounds (PTRDIFF_MIN, XINT (w->redisplay_end_trigger), PTRDIFF_MAX); it->tab_width = SANE_TAB_WIDTH (current_buffer); @@ -3326,7 +3326,7 @@ compute_stop_pos (struct it *it) interval if there isn't such an interval. */ position = make_number (charpos); iv = validate_interval_range (object, &position, &position, 0); - if (!NULL_INTERVAL_P (iv)) + if (iv) { Lisp_Object values_here[LAST_PROP_IDX]; struct props *p; @@ -3338,7 +3338,7 @@ compute_stop_pos (struct it *it) /* Look for an interval following iv that has different properties. */ for (next_iv = next_interval (iv); - (!NULL_INTERVAL_P (next_iv) + (next_iv && (NILP (limit) || XFASTINT (limit) > next_iv->position)); next_iv = next_interval (next_iv)) @@ -3356,7 +3356,7 @@ compute_stop_pos (struct it *it) break; } - if (!NULL_INTERVAL_P (next_iv)) + if (next_iv) { if (INTEGERP (limit) && next_iv->position >= XFASTINT (limit)) @@ -4413,7 +4413,7 @@ handle_display_prop (struct it *it) if it was a text property. */ if (!STRINGP (it->string)) - object = WVAR (it->w, buffer); + object = it->w->buffer; display_replaced_p = handle_display_spec (it, propval, object, overlay, position, bufpos, @@ -4824,7 +4824,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, it->what = IT_IMAGE; it->image_id = -1; /* no image */ it->position = start_pos; - it->object = NILP (object) ? WVAR (it->w, buffer) : object; + it->object = NILP (object) ? it->w->buffer : object; it->method = GET_FROM_IMAGE; it->from_overlay = Qnil; it->face_id = face_id; @@ -4987,7 +4987,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, it->what = IT_IMAGE; it->image_id = lookup_image (it->f, value); it->position = start_pos; - it->object = NILP (object) ? WVAR (it->w, buffer) : object; + it->object = NILP (object) ? it->w->buffer : object; it->method = GET_FROM_IMAGE; /* Say that we haven't consumed the characters with @@ -5820,7 +5820,7 @@ pop_it (struct it *it) it->object = p->u.stretch.object; break; case GET_FROM_BUFFER: - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; break; case GET_FROM_STRING: it->object = it->string; @@ -5833,7 +5833,7 @@ pop_it (struct it *it) else { it->method = GET_FROM_BUFFER; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; } } it->end_charpos = p->end_charpos; @@ -6271,7 +6271,7 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p) IT_STRING_BYTEPOS (*it) = -1; it->string = Qnil; it->method = GET_FROM_BUFFER; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; it->area = TEXT_AREA; it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); it->sp = 0; @@ -7123,7 +7123,7 @@ set_iterator_to_next (struct it *it, int reseat_p) else { it->method = GET_FROM_BUFFER; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; } it->dpvec = NULL; @@ -7701,7 +7701,7 @@ next_element_from_ellipsis (struct it *it) setting face_before_selective_p. */ it->saved_face_id = it->face_id; it->method = GET_FROM_BUFFER; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; reseat_at_next_visible_line_start (it, 1); it->face_before_selective_p = 1; } @@ -7978,7 +7978,7 @@ next_element_from_buffer (struct it *it) /* Record what we have and where it came from. */ it->what = IT_CHARACTER; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; it->position = it->current.pos; /* Normally we return the character found above, except when we @@ -8035,7 +8035,7 @@ run_redisplay_end_trigger_hook (struct it *it) /* Since we are *trying* to run these functions, don't try to run them again, even if they get an error. */ - WVAR (it->w, redisplay_end_trigger) = Qnil; + WSET (it->w, redisplay_end_trigger, Qnil); Frun_hook_with_args (3, args); /* Notice if it changed the face of the character we are on. */ @@ -8084,7 +8084,7 @@ next_element_from_composition (struct it *it) return 0; } it->position = it->current.pos; - it->object = WVAR (it->w, buffer); + it->object = it->w->buffer; it->c = composition_update_it (&it->cmp_it, IT_CHARPOS (*it), IT_BYTEPOS (*it), Qnil); } @@ -8945,7 +8945,7 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int to_x, int to_y, int to_vpos && it->current_x == it->last_visible_x - 1 && it->c != '\n' && it->c != '\t' - && it->vpos < XFASTINT (WVAR (it->w, window_end_vpos))) + && it->vpos < XFASTINT (it->w->window_end_vpos)) { it->continuation_lines_width += it->current_x; it->current_x = it->hpos = it->max_ascent = it->max_descent = 0; @@ -9322,7 +9322,7 @@ add_to_log (const char *format, Lisp_Object arg1, Lisp_Object arg2) msg = Fformat (3, args); len = SBYTES (msg) + 1; - SAFE_ALLOCA (buffer, char *, len); + buffer = SAFE_ALLOCA (len); memcpy (buffer, SDATA (msg), len); message_dolog (buffer, len - 1, 1, 0); @@ -9372,7 +9372,7 @@ message_dolog (const char *m, ptrdiff_t nbytes, int nlflag, int multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); - BVAR (current_buffer, undo_list) = Qt; + BSET (current_buffer, undo_list, Qt); oldpoint = message_dolog_marker1; set_marker_restricted (oldpoint, make_number (PT), Qnil); @@ -9649,10 +9649,8 @@ message3 (Lisp_Object m, ptrdiff_t nbytes, int multibyte) message_log_maybe_newline (); if (STRINGP (m)) { - char *buffer; USE_SAFE_ALLOCA; - - SAFE_ALLOCA (buffer, char *, nbytes); + char *buffer = SAFE_ALLOCA (nbytes); memcpy (buffer, SDATA (m), nbytes); message_dolog (buffer, nbytes, 1, multibyte); SAFE_FREE (); @@ -9699,7 +9697,7 @@ message3_nolog (Lisp_Object m, ptrdiff_t nbytes, int multibyte) /* Get the frame containing the mini-buffer that the selected frame is using. */ mini_window = FRAME_MINIBUF_WINDOW (sf); - frame = WVAR (XWINDOW (mini_window), frame); + frame = XWINDOW (mini_window)->frame; f = XFRAME (frame); FRAME_SAMPLE_VISIBILITY (f); @@ -9936,7 +9934,7 @@ ensure_echo_area_buffers (void) old_buffer = echo_buffer[i]; echo_buffer[i] = Fget_buffer_create (make_formatted_string (name, " *Echo Area %d*", i)); - BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; + BSET (XBUFFER (echo_buffer[i]), truncate_lines, Qnil); /* to force word wrap in echo area - it was decided to postpone this*/ /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ @@ -10025,12 +10023,12 @@ with_echo_area_buffer (struct window *w, int which, set_buffer_internal_1 (XBUFFER (buffer)); if (w) { - WVAR (w, buffer) = buffer; - set_marker_both (WVAR (w, pointm), buffer, BEG, BEG_BYTE); + WSET (w, buffer, buffer); + set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); } - BVAR (current_buffer, undo_list) = Qt; - BVAR (current_buffer, read_only) = Qnil; + BSET (current_buffer, undo_list, Qt); + BSET (current_buffer, read_only, Qnil); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -10074,9 +10072,9 @@ with_echo_area_buffer_unwind_data (struct window *w) if (w) { XSETWINDOW (tmp, w); ASET (vector, i, tmp); ++i; - ASET (vector, i, WVAR (w, buffer)); ++i; - ASET (vector, i, make_number (XMARKER (WVAR (w, pointm))->charpos)); ++i; - ASET (vector, i, make_number (XMARKER (WVAR (w, pointm))->bytepos)); ++i; + ASET (vector, i, w->buffer); ++i; + ASET (vector, i, make_number (XMARKER (w->pointm)->charpos)); ++i; + ASET (vector, i, make_number (XMARKER (w->pointm)->bytepos)); ++i; } else { @@ -10110,8 +10108,8 @@ unwind_with_echo_area_buffer (Lisp_Object vector) charpos = AREF (vector, 5); bytepos = AREF (vector, 6); - WVAR (w, buffer) = buffer; - set_marker_both (WVAR (w, pointm), buffer, + WSET (w, buffer, buffer); + set_marker_both (w->pointm, buffer, XFASTINT (charpos), XFASTINT (bytepos)); } @@ -10143,7 +10141,7 @@ setup_echo_area_for_printing (int multibyte_p) /* Switch to that buffer and clear it. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - BVAR (current_buffer, truncate_lines) = Qnil; + BSET (current_buffer, truncate_lines, Qnil); if (Z > BEG) { @@ -10186,7 +10184,7 @@ setup_echo_area_for_printing (int multibyte_p) { /* Someone switched buffers between print requests. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - BVAR (current_buffer, truncate_lines) = Qnil; + BSET (current_buffer, truncate_lines, Qnil); } } } @@ -10250,7 +10248,7 @@ display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t a3, ptrdiff_t a4) window_height_changed_p = resize_mini_window (w, 0); /* Use the starting position chosen by resize_mini_window. */ - SET_TEXT_POS_FROM_MARKER (start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start, w->start); /* Display. */ clear_glyph_matrix (w->desired_matrix); @@ -10321,15 +10319,15 @@ resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly, ptrdiff_t a3, ptrdiff_t int resize_mini_window (struct window *w, int exact_p) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int window_height_changed_p = 0; eassert (MINI_WINDOW_P (w)); /* By default, start display at the beginning. */ - set_marker_both (WVAR (w, start), WVAR (w, buffer), - BUF_BEGV (XBUFFER (WVAR (w, buffer))), - BUF_BEGV_BYTE (XBUFFER (WVAR (w, buffer)))); + set_marker_both (w->start, w->buffer, + BUF_BEGV (XBUFFER (w->buffer)), + BUF_BEGV_BYTE (XBUFFER (w->buffer))); /* Don't resize windows while redisplaying a window; it would confuse redisplay functions when the size of the window they are @@ -10356,10 +10354,10 @@ resize_mini_window (struct window *w, int exact_p) struct text_pos start; struct buffer *old_current_buffer = NULL; - if (current_buffer != XBUFFER (WVAR (w, buffer))) + if (current_buffer != XBUFFER (w->buffer)) { old_current_buffer = current_buffer; - set_buffer_internal (XBUFFER (WVAR (w, buffer))); + set_buffer_internal (XBUFFER (w->buffer)); } init_iterator (&it, w, BEGV, BEGV_BYTE, NULL, DEFAULT_FACE_ID); @@ -10401,7 +10399,7 @@ resize_mini_window (struct window *w, int exact_p) } else SET_TEXT_POS (start, BEGV, BEGV_BYTE); - SET_MARKER_FROM_TEXT_POS (WVAR (w, start), start); + SET_MARKER_FROM_TEXT_POS (w->start, start); if (EQ (Vresize_mini_windows, Qgrow_only)) { @@ -10638,9 +10636,9 @@ set_message_1 (ptrdiff_t a1, Lisp_Object a2, ptrdiff_t nbytes, ptrdiff_t multiby != !NILP (BVAR (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); - BVAR (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; + BSET (current_buffer, truncate_lines, message_truncate_lines ? Qt : Qnil); if (!NILP (BVAR (current_buffer, bidi_display_reordering))) - BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right; + BSET (current_buffer, bidi_paragraph_direction, Qleft_to_right); /* Insert new message at BEG. */ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -10947,7 +10945,7 @@ format_mode_line_unwind_data (struct frame *target_frame, /* Similarly to `with-selected-window', if the operation selects a window on another frame, we must restore that frame's selected window, and (for a tty) the top-frame. */ - ASET (vector, 8, FVAR (target_frame, selected_window)); + ASET (vector, 8, target_frame->selected_window); if (FRAME_TERMCAP_P (target_frame)) ASET (vector, 9, FRAME_TTY (target_frame)->top_frame); } @@ -11107,14 +11105,14 @@ x_consider_frame_title (Lisp_Object frame) format_mode_line_unwind_data (f, current_buffer, selected_window, 0)); - Fselect_window (FVAR (f, selected_window), Qt); + Fselect_window (f->selected_window, Qt); set_buffer_internal_1 - (XBUFFER (WVAR (XWINDOW (FVAR (f, selected_window)), buffer))); + (XBUFFER (XWINDOW (f->selected_window)->buffer)); fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format; mode_line_target = MODE_LINE_TITLE; title_start = MODE_LINE_NOPROP_LEN (0); - init_iterator (&it, XWINDOW (FVAR (f, selected_window)), -1, -1, + init_iterator (&it, XWINDOW (f->selected_window), -1, -1, NULL, DEFAULT_FACE_ID); display_mode_element (&it, 0, -1, -1, fmt, Qnil, 0); len = MODE_LINE_NOPROP_LEN (title_start); @@ -11126,9 +11124,9 @@ x_consider_frame_title (Lisp_Object frame) already wasted too much time by walking through the list with display_mode_element, then we might need to optimize at a higher level than this.) */ - if (! STRINGP (FVAR (f, name)) - || SBYTES (FVAR (f, name)) != len - || memcmp (title, SDATA (FVAR (f, name)), len) != 0) + if (! STRINGP (f->name) + || SBYTES (f->name) != len + || memcmp (title, SDATA (f->name), len) != 0) x_implicitly_set_name (f, make_string (title, len), Qnil); } } @@ -11227,9 +11225,8 @@ prepare_menu_bars (void) #ifdef HAVE_NS if (windows_or_buffers_changed && FRAME_NS_P (f)) - ns_set_doc_edited - (f, Fbuffer_modified_p - (WVAR (XWINDOW (FVAR (f, selected_window)), buffer))); + ns_set_doc_edited + (f, Fbuffer_modified_p (XWINDOW (f->selected_window)->buffer)); #endif UNGCPRO; } @@ -11294,19 +11291,19 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) /* This used to test w->update_mode_line, but we believe there is no need to recompute the menu in that case. */ || update_mode_lines - || ((BUF_SAVE_MODIFF (XBUFFER (WVAR (w, buffer))) - < BUF_MODIFF (XBUFFER (WVAR (w, buffer)))) + || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) + < BUF_MODIFF (XBUFFER (w->buffer))) != w->last_had_star) || ((!NILP (Vtransient_mark_mode) - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), mark_active))) - != !NILP (WVAR (w, region_showing)))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) + != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; ptrdiff_t count = SPECPDL_INDEX (); specbind (Qinhibit_menubar_update, Qt); - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + set_buffer_internal_1 (XBUFFER (w->buffer)); if (save_match_data) record_unwind_save_match_data (); if (NILP (Voverriding_local_map_menu_flag)) @@ -11331,7 +11328,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) } XSETFRAME (Vmenu_updating_frame, f); - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); /* Redisplay the menu bar in case we changed it. */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) \ @@ -11470,8 +11467,8 @@ update_tool_bar (struct frame *f, int save_match_data) #if defined (USE_GTK) || defined (HAVE_NS) int do_update = FRAME_EXTERNAL_TOOL_BAR (f); #else - int do_update = WINDOWP (FVAR (f, tool_bar_window)) - && WINDOW_TOTAL_LINES (XWINDOW (FVAR (f, tool_bar_window))) > 0; + int do_update = WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)) > 0; #endif if (do_update) @@ -11492,12 +11489,12 @@ update_tool_bar (struct frame *f, int save_match_data) if (windows_or_buffers_changed || w->update_mode_line || update_mode_lines - || ((BUF_SAVE_MODIFF (XBUFFER (WVAR (w, buffer))) - < BUF_MODIFF (XBUFFER (WVAR (w, buffer)))) + || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) + < BUF_MODIFF (XBUFFER (w->buffer))) != w->last_had_star) || ((!NILP (Vtransient_mark_mode) - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), mark_active))) - != !NILP (WVAR (w, region_showing)))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) + != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; ptrdiff_t count = SPECPDL_INDEX (); @@ -11508,7 +11505,7 @@ update_tool_bar (struct frame *f, int save_match_data) /* Set current_buffer to the buffer of the selected window of the frame, so that we get the right local keymaps. */ - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + set_buffer_internal_1 (XBUFFER (w->buffer)); /* Save match data, if we must. */ if (save_match_data) @@ -11532,18 +11529,19 @@ update_tool_bar (struct frame *f, int save_match_data) selected_frame = frame; /* Build desired tool-bar items from keymaps. */ - new_tool_bar = tool_bar_items - (Fcopy_sequence (FVAR (f, tool_bar_items)), &new_n_tool_bar); + new_tool_bar + = tool_bar_items (Fcopy_sequence (f->tool_bar_items), + &new_n_tool_bar); /* Redisplay the tool-bar if we changed it. */ if (new_n_tool_bar != f->n_tool_bar_items - || NILP (Fequal (new_tool_bar, FVAR (f, tool_bar_items)))) + || NILP (Fequal (new_tool_bar, f->tool_bar_items))) { /* Redisplay that happens asynchronously due to an expose event may access f->tool_bar_items. Make sure we update both variables within BLOCK_INPUT so no such event interrupts. */ BLOCK_INPUT; - FVAR (f, tool_bar_items) = new_tool_bar; + FSET (f, tool_bar_items, new_tool_bar); f->n_tool_bar_items = new_n_tool_bar; w->update_mode_line = 1; UNBLOCK_INPUT; @@ -11576,22 +11574,22 @@ build_desired_tool_bar_string (struct frame *f) Otherwise, make a new string. */ /* The size of the string we might be able to reuse. */ - size = (STRINGP (FVAR (f, desired_tool_bar_string)) - ? SCHARS (FVAR (f, desired_tool_bar_string)) + size = (STRINGP (f->desired_tool_bar_string) + ? SCHARS (f->desired_tool_bar_string) : 0); /* We need one space in the string for each image. */ size_needed = f->n_tool_bar_items; /* Reuse f->desired_tool_bar_string, if possible. */ - if (size < size_needed || NILP (FVAR (f, desired_tool_bar_string))) - FVAR (f, desired_tool_bar_string) - = Fmake_string (make_number (size_needed), make_number (' ')); + if (size < size_needed || NILP (f->desired_tool_bar_string)) + FSET (f, desired_tool_bar_string, + Fmake_string (make_number (size_needed), make_number (' '))); else { props = list4 (Qdisplay, Qnil, Qmenu_item, Qnil); Fremove_text_properties (make_number (0), make_number (size), - props, FVAR (f, desired_tool_bar_string)); + props, f->desired_tool_bar_string); } /* Put a `display' property on the string for the images to display, @@ -11600,7 +11598,7 @@ build_desired_tool_bar_string (struct frame *f) for (i = 0; i < f->n_tool_bar_items; ++i) { #define PROP(IDX) \ - AREF (FVAR (f, tool_bar_items), i * TOOL_BAR_ITEM_NSLOTS + (IDX)) + AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX)) int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P)); int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P)); @@ -11709,11 +11707,11 @@ build_desired_tool_bar_string (struct frame *f) string. The string can be longer than needed when we reuse a previous string. */ if (i + 1 == f->n_tool_bar_items) - end = SCHARS (FVAR (f, desired_tool_bar_string)); + end = SCHARS (f->desired_tool_bar_string); else end = i + 1; Fadd_text_properties (make_number (i), make_number (end), - props, FVAR (f, desired_tool_bar_string)); + props, f->desired_tool_bar_string); #undef PROP } @@ -11863,7 +11861,7 @@ display_tool_bar_line (struct it *it, int height) static int tool_bar_lines_needed (struct frame *f, int *n_rows) { - struct window *w = XWINDOW (FVAR (f, tool_bar_window)); + struct window *w = XWINDOW (f->tool_bar_window); struct it it; /* tool_bar_lines_needed is called from redisplay_tool_bar after building the desired matrix, so use (unused) mode-line row as temporary row to @@ -11875,7 +11873,7 @@ tool_bar_lines_needed (struct frame *f, int *n_rows) init_iterator (&it, w, -1, -1, temp_row, TOOL_BAR_FACE_ID); it.first_visible_x = 0; it.last_visible_x = FRAME_TOTAL_COLS (f) * FRAME_COLUMN_WIDTH (f); - reseat_to_string (&it, NULL, FVAR (f, desired_tool_bar_string), 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); it.paragraph_embedding = L2R; while (!ITERATOR_AT_END_P (&it)) @@ -11909,8 +11907,8 @@ DEFUN ("tool-bar-lines-needed", Ftool_bar_lines_needed, Stool_bar_lines_needed, CHECK_FRAME (frame); f = XFRAME (frame); - if (WINDOWP (FVAR (f, tool_bar_window)) - && (w = XWINDOW (FVAR (f, tool_bar_window)), + if (WINDOWP (f->tool_bar_window) + && (w = XWINDOW (f->tool_bar_window), WINDOW_TOTAL_LINES (w) > 0)) { update_tool_bar (f, 1); @@ -11945,8 +11943,8 @@ redisplay_tool_bar (struct frame *f) do anything. This means you must start with tool-bar-lines non-zero to get the auto-sizing effect. Or in other words, you can turn off tool-bars by specifying tool-bar-lines zero. */ - if (!WINDOWP (FVAR (f, tool_bar_window)) - || (w = XWINDOW (FVAR (f, tool_bar_window)), + if (!WINDOWP (f->tool_bar_window) + || (w = XWINDOW (f->tool_bar_window), WINDOW_TOTAL_LINES (w) == 0)) return 0; @@ -11958,7 +11956,7 @@ redisplay_tool_bar (struct frame *f) /* Build a string that represents the contents of the tool-bar. */ build_desired_tool_bar_string (f); - reseat_to_string (&it, NULL, FVAR (f, desired_tool_bar_string), 0, 0, 0, -1); + reseat_to_string (&it, NULL, f->desired_tool_bar_string, 0, 0, 0, -1); /* FIXME: This should be controlled by a user option. But it doesn't make sense to have an R2L tool bar if the menu bar cannot be drawn also R2L, and making the menu bar R2L is tricky due @@ -12115,14 +12113,14 @@ tool_bar_item_info (struct frame *f, struct glyph *glyph, int *prop_idx) /* This function can be called asynchronously, which means we must exclude any possibility that Fget_text_property signals an error. */ - charpos = min (SCHARS (FVAR (f, current_tool_bar_string)), glyph->charpos); + charpos = min (SCHARS (f->current_tool_bar_string), glyph->charpos); charpos = max (0, charpos); /* Get the text property `menu-item' at pos. The value of that property is the start index of this item's properties in F->tool_bar_items. */ prop = Fget_text_property (make_number (charpos), - Qmenu_item, FVAR (f, current_tool_bar_string)); + Qmenu_item, f->current_tool_bar_string); if (INTEGERP (prop)) { *prop_idx = XINT (prop); @@ -12150,7 +12148,7 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, int *hpos, int *vpos, int *prop_idx) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - struct window *w = XWINDOW (FVAR (f, tool_bar_window)); + struct window *w = XWINDOW (f->tool_bar_window); int area; /* Find the glyph under X/Y. */ @@ -12164,7 +12162,7 @@ get_tool_bar_item (struct frame *f, int x, int y, struct glyph **glyph, return -1; /* Is mouse on the highlighted item? */ - if (EQ (FVAR (f, tool_bar_window), hlinfo->mouse_face_window) + if (EQ (f->tool_bar_window, hlinfo->mouse_face_window) && *vpos >= hlinfo->mouse_face_beg_row && *vpos <= hlinfo->mouse_face_end_row && (*vpos > hlinfo->mouse_face_beg_row @@ -12189,7 +12187,7 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, int modifiers) { Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - struct window *w = XWINDOW (FVAR (f, tool_bar_window)); + struct window *w = XWINDOW (f->tool_bar_window); int hpos, vpos, prop_idx; struct glyph *glyph; Lisp_Object enabled_p; @@ -12200,7 +12198,7 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, return; /* If item is disabled, do nothing. */ - enabled_p = AREF (FVAR (f, tool_bar_items), prop_idx + TOOL_BAR_ITEM_ENABLED_P); + enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P); if (NILP (enabled_p)) return; @@ -12221,7 +12219,7 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); hlinfo->mouse_face_image_state = DRAW_IMAGE_RAISED; - key = AREF (FVAR (f, tool_bar_items), prop_idx + TOOL_BAR_ITEM_KEY); + key = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_KEY); XSETFRAME (frame, f); event.kind = TOOL_BAR_EVENT; @@ -12246,7 +12244,7 @@ handle_tool_bar_click (struct frame *f, int x, int y, int down_p, static void note_tool_bar_highlight (struct frame *f, int x, int y) { - Lisp_Object window = FVAR (f, tool_bar_window); + Lisp_Object window = f->tool_bar_window; struct window *w = XWINDOW (window); Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); @@ -12292,7 +12290,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; /* If tool-bar item is not enabled, don't highlight it. */ - enabled_p = AREF (FVAR (f, tool_bar_items), prop_idx + TOOL_BAR_ITEM_ENABLED_P); + enabled_p = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_ENABLED_P); if (!NILP (enabled_p)) { /* Compute the x-position of the glyph. In front and past the @@ -12326,9 +12324,9 @@ note_tool_bar_highlight (struct frame *f, int x, int y) XTread_socket does the rest. */ help_echo_object = help_echo_window = Qnil; help_echo_pos = -1; - help_echo_string = AREF (FVAR (f, tool_bar_items), prop_idx + TOOL_BAR_ITEM_HELP); + help_echo_string = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_HELP); if (NILP (help_echo_string)) - help_echo_string = AREF (FVAR (f, tool_bar_items), prop_idx + TOOL_BAR_ITEM_CAPTION); + help_echo_string = AREF (f->tool_bar_items, prop_idx + TOOL_BAR_ITEM_CAPTION); } #endif /* HAVE_WINDOW_SYSTEM */ @@ -12378,10 +12376,10 @@ hscroll_window_tree (Lisp_Object window) { struct window *w = XWINDOW (window); - if (WINDOWP (WVAR (w, hchild))) - hscrolled_p |= hscroll_window_tree (WVAR (w, hchild)); - else if (WINDOWP (WVAR (w, vchild))) - hscrolled_p |= hscroll_window_tree (WVAR (w, vchild)); + if (WINDOWP (w->hchild)) + hscrolled_p |= hscroll_window_tree (w->hchild); + else if (WINDOWP (w->vchild)) + hscrolled_p |= hscroll_window_tree (w->vchild); else if (w->cursor.vpos >= 0) { int h_margin; @@ -12401,7 +12399,7 @@ hscroll_window_tree (Lisp_Object window) /* Scroll when cursor is inside this scroll margin. */ h_margin = hscroll_margin * WINDOW_FRAME_COLUMN_WIDTH (w); - if (!NILP (Fbuffer_local_value (Qauto_hscroll_mode, WVAR (w, buffer))) + if (!NILP (Fbuffer_local_value (Qauto_hscroll_mode, w->buffer)) /* For left-to-right rows, hscroll when cursor is either (i) inside the right hscroll margin, or (ii) if it is inside the left margin and the window is already @@ -12436,13 +12434,13 @@ hscroll_window_tree (Lisp_Object window) /* Find point in a display of infinite width. */ saved_current_buffer = current_buffer; - current_buffer = XBUFFER (WVAR (w, buffer)); + current_buffer = XBUFFER (w->buffer); if (w == XWINDOW (selected_window)) pt = PT; else { - pt = marker_position (WVAR (w, pointm)); + pt = marker_position (w->pointm); pt = max (BEGV, pt); pt = min (ZV, pt); } @@ -12493,14 +12491,14 @@ hscroll_window_tree (Lisp_Object window) redisplay. */ if (w->hscroll != hscroll) { - XBUFFER (WVAR (w, buffer))->prevent_redisplay_optimizations_p = 1; + XBUFFER (w->buffer)->prevent_redisplay_optimizations_p = 1; w->hscroll = hscroll; hscrolled_p = 1; } } } - window = WVAR (w, next); + window = w->next; } /* Value is non-zero if hscroll of any leaf window has been changed. */ @@ -12582,9 +12580,9 @@ debug_method_add (struct window *w, char const *fmt, ...) if (trace_redisplay_p) fprintf (stderr, "%p (%s): %s\n", w, - ((BUFFERP (WVAR (w, buffer)) - && STRINGP (BVAR (XBUFFER (WVAR (w, buffer)), name))) - ? SSDATA (BVAR (XBUFFER (WVAR (w, buffer)), name)) + ((BUFFERP (w->buffer) + && STRINGP (BVAR (XBUFFER (w->buffer), name))) + ? SSDATA (BVAR (XBUFFER (w->buffer), name)) : "no buffer"), method + len); } @@ -12649,8 +12647,8 @@ text_outside_line_unchanged_p (struct window *w, require to redisplay the whole paragraph. It might be worthwhile to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization. */ - if (!NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering)) - && NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_paragraph_direction))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) unchanged_p = 0; } @@ -12862,7 +12860,7 @@ static inline void reconsider_clip_changes (struct window *w, struct buffer *b) { if (b->clip_changed - && !NILP (WVAR (w, window_end_valid)) + && !NILP (w->window_end_valid) && w->current_matrix->buffer == b && w->current_matrix->zv == BUF_ZV (b) && w->current_matrix->begv == BUF_BEGV (b)) @@ -12874,20 +12872,20 @@ reconsider_clip_changes (struct window *w, struct buffer *b) b->clip_changed has already been set to 1, we can skip this check. */ if (!b->clip_changed - && BUFFERP (WVAR (w, buffer)) && !NILP (WVAR (w, window_end_valid))) + && BUFFERP (w->buffer) && !NILP (w->window_end_valid)) { ptrdiff_t pt; if (w == XWINDOW (selected_window)) pt = PT; else - pt = marker_position (WVAR (w, pointm)); + pt = marker_position (w->pointm); - if ((w->current_matrix->buffer != XBUFFER (WVAR (w, buffer)) + if ((w->current_matrix->buffer != XBUFFER (w->buffer) || pt != w->last_point) && check_point_in_composition (w->current_matrix->buffer, w->last_point, - XBUFFER (WVAR (w, buffer)), pt)) + XBUFFER (w->buffer), pt)) b->clip_changed = 1; } } @@ -12909,7 +12907,7 @@ select_frame_for_redisplay (Lisp_Object frame) selected_frame = frame; do { - for (tail = FVAR (XFRAME (frame), param_alist); + for (tail = XFRAME (frame)->param_alist; CONSP (tail); tail = XCDR (tail)) if (CONSP (XCAR (tail)) && (tem = XCAR (XCAR (tail)), @@ -12970,7 +12968,7 @@ redisplay_internal (void) /* Don't examine these until after testing Vinhibit_redisplay. When Emacs is shutting down, perhaps because its connection to X has dropped, we should not look at them at all. */ - fr = XFRAME (WVAR (w, frame)); + fr = XFRAME (w->frame); sf = SELECTED_FRAME (); if (!fr->glyphs_initialized_p) @@ -13106,18 +13104,18 @@ redisplay_internal (void) specbind (Qinhibit_point_motion_hooks, Qt); /* If %c is in the mode line, update it if needed. */ - if (!NILP (WVAR (w, column_number_displayed)) + if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ && !(PT == w->last_point && w->last_modified >= MODIFF && w->last_overlay_modified >= OVERLAY_MODIFF) - && (XFASTINT (WVAR (w, column_number_displayed)) != current_column ())) + && (XFASTINT (w->column_number_displayed) != current_column ())) w->update_mode_line = 1; unbind_to (count1, Qnil); - FRAME_SCROLL_BOTTOM_VPOS (XFRAME (WVAR (w, frame))) = -1; + FRAME_SCROLL_BOTTOM_VPOS (XFRAME (w->frame)) = -1; /* The variable buffer_shared is set in redisplay_window and indicates that we redisplay a buffer in different windows. See @@ -13201,11 +13199,11 @@ redisplay_internal (void) the whole window. The assignment to this_line_start_pos prevents the optimization directly below this if-statement. */ if (((!NILP (Vtransient_mark_mode) - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), mark_active))) - != !NILP (WVAR (w, region_showing))) - || (!NILP (WVAR (w, region_showing)) - && !EQ (WVAR (w, region_showing), - Fmarker_position (BVAR (XBUFFER (WVAR (w, buffer)), mark))))) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) + != !NILP (w->region_showing)) + || (!NILP (w->region_showing) + && !EQ (w->region_showing, + Fmarker_position (BVAR (XBUFFER (w->buffer), mark))))) CHARPOS (this_line_start_pos) = 0; /* Optimize the case that only the line containing the cursor in the @@ -13219,11 +13217,11 @@ redisplay_internal (void) && !w->update_mode_line && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p - && FRAME_VISIBLE_P (XFRAME (WVAR (w, frame))) - && !FRAME_OBSCURED_P (XFRAME (WVAR (w, frame))) + && FRAME_VISIBLE_P (XFRAME (w->frame)) + && !FRAME_OBSCURED_P (XFRAME (w->frame)) /* Make sure recorded data applies to current buffer, etc. */ && this_line_buffer == current_buffer - && current_buffer == XBUFFER (WVAR (w, buffer)) + && current_buffer == XBUFFER (w->buffer) && !w->force_start && !w->optional_new_start /* Point must be on the line that we have info recorded about. */ @@ -13321,13 +13319,13 @@ redisplay_internal (void) adjusted. */ if ((it.glyph_row - 1)->displays_text_p) { - if (XFASTINT (WVAR (w, window_end_vpos)) < this_line_vpos) - XSETINT (WVAR (w, window_end_vpos), this_line_vpos); + if (XFASTINT (w->window_end_vpos) < this_line_vpos) + WSET (w, window_end_vpos, make_number (this_line_vpos)); } - else if (XFASTINT (WVAR (w, window_end_vpos)) == this_line_vpos + else if (XFASTINT (w->window_end_vpos) == this_line_vpos && this_line_vpos > 0) - XSETINT (WVAR (w, window_end_vpos), this_line_vpos - 1); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_vpos, make_number (this_line_vpos - 1)); + WSET (w, window_end_valid, Qnil); /* Update hint: No need to try to scroll in update_window. */ w->desired_matrix->no_scrolling_p = 1; @@ -13380,7 +13378,7 @@ redisplay_internal (void) && (EQ (selected_window, BVAR (current_buffer, last_selected_window)) || highlight_nonselected_windows) - && NILP (WVAR (w, region_showing)) + && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) && !cursor_in_echo_area) { @@ -13490,7 +13488,7 @@ redisplay_internal (void) if (!f->already_hscrolled_p) { f->already_hscrolled_p = 1; - if (hscroll_windows (FVAR (f, root_window))) + if (hscroll_windows (f->root_window)) goto retry; } @@ -13503,7 +13501,7 @@ redisplay_internal (void) STOP_POLLING; /* Update the display. */ - set_window_update_flags (XWINDOW (FVAR (f, root_window)), 1); + set_window_update_flags (XWINDOW (f->root_window), 1); pending |= update_frame (f, 0, 0); f->updated_p = 1; } @@ -13516,7 +13514,7 @@ redisplay_internal (void) and selected_window to be temporarily out-of-sync but let's make sure this stays contained. */ select_frame_for_redisplay (old_frame); - eassert (EQ (FVAR (XFRAME (selected_frame), selected_window), + eassert (EQ (XFRAME (selected_frame)->selected_window, selected_window)); if (!pending) @@ -13529,7 +13527,7 @@ redisplay_internal (void) struct frame *f = XFRAME (frame); if (f->updated_p) { - mark_window_display_accurate (FVAR (f, root_window), 1); + mark_window_display_accurate (f->root_window, 1); if (FRAME_TERMINAL (f)->frame_up_to_date_hook) FRAME_TERMINAL (f)->frame_up_to_date_hook (f); } @@ -13541,7 +13539,7 @@ redisplay_internal (void) Lisp_Object mini_window = FRAME_MINIBUF_WINDOW (sf); struct frame *mini_frame; - displayed_buffer = XBUFFER (WVAR (XWINDOW (selected_window), buffer)); + displayed_buffer = XBUFFER (XWINDOW (selected_window)->buffer); /* Use list_of_error, not Qerror, so that we catch only errors and don't run the debugger. */ internal_condition_case_1 (redisplay_window_1, selected_window, @@ -13607,7 +13605,7 @@ redisplay_internal (void) /* If we pause after scrolling, some rows in the current matrices of some windows are not valid. */ if (!WINDOW_FULL_WIDTH_P (w) - && !FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))) + && !FRAME_WINDOW_P (XFRAME (w->frame))) update_mode_lines = 1; } else @@ -13765,9 +13763,9 @@ unwind_redisplay (Lisp_Object val) static void mark_window_display_accurate_1 (struct window *w, int accurate_p) { - if (BUFFERP (WVAR (w, buffer))) + if (BUFFERP (w->buffer)) { - struct buffer *b = XBUFFER (WVAR (w, buffer)); + struct buffer *b = XBUFFER (w->buffer); w->last_modified = accurate_p ? BUF_MODIFF(b) : 0; w->last_overlay_modified = accurate_p ? BUF_OVERLAY_MODIFF(b) : 0; @@ -13794,13 +13792,13 @@ mark_window_display_accurate_1 (struct window *w, int accurate_p) if (w == XWINDOW (selected_window)) w->last_point = BUF_PT (b); else - w->last_point = XMARKER (WVAR (w, pointm))->charpos; + w->last_point = XMARKER (w->pointm)->charpos; } } if (accurate_p) { - WVAR (w, window_end_valid) = WVAR (w, buffer); + WSET (w, window_end_valid, w->buffer); w->update_mode_line = 0; } } @@ -13816,15 +13814,15 @@ mark_window_display_accurate (Lisp_Object window, int accurate_p) { struct window *w; - for (; !NILP (window); window = WVAR (w, next)) + for (; !NILP (window); window = w->next) { w = XWINDOW (window); mark_window_display_accurate_1 (w, accurate_p); - if (!NILP (WVAR (w, vchild))) - mark_window_display_accurate (WVAR (w, vchild), accurate_p); - if (!NILP (WVAR (w, hchild))) - mark_window_display_accurate (WVAR (w, hchild), accurate_p); + if (!NILP (w->vchild)) + mark_window_display_accurate (w->vchild, accurate_p); + if (!NILP (w->hchild)) + mark_window_display_accurate (w->hchild, accurate_p); } if (accurate_p) @@ -13884,13 +13882,13 @@ redisplay_windows (Lisp_Object window) { struct window *w = XWINDOW (window); - if (!NILP (WVAR (w, hchild))) - redisplay_windows (WVAR (w, hchild)); - else if (!NILP (WVAR (w, vchild))) - redisplay_windows (WVAR (w, vchild)); - else if (!NILP (WVAR (w, buffer))) + if (!NILP (w->hchild)) + redisplay_windows (w->hchild); + else if (!NILP (w->vchild)) + redisplay_windows (w->vchild); + else if (!NILP (w->buffer)) { - displayed_buffer = XBUFFER (WVAR (w, buffer)); + displayed_buffer = XBUFFER (w->buffer); /* Use list_of_error, not Qerror, so that we catch only errors and don't run the debugger. */ internal_condition_case_1 (redisplay_window_0, window, @@ -13898,7 +13896,7 @@ redisplay_windows (Lisp_Object window) redisplay_window_error); } - window = WVAR (w, next); + window = w->next; } } @@ -14532,7 +14530,7 @@ set_cursor_from_row (struct window *w, struct glyph_row *row, && !MATRIX_ROW_CONTINUATION_LINE_P (row) && row->x == 0) { - this_line_buffer = XBUFFER (WVAR (w, buffer)); + this_line_buffer = XBUFFER (w->buffer); CHARPOS (this_line_start_pos) = MATRIX_ROW_START_CHARPOS (row) + delta; @@ -14566,19 +14564,19 @@ static inline struct text_pos run_window_scroll_functions (Lisp_Object window, struct text_pos startp) { struct window *w = XWINDOW (window); - SET_MARKER_FROM_TEXT_POS (WVAR (w, start), startp); + SET_MARKER_FROM_TEXT_POS (w->start, startp); - if (current_buffer != XBUFFER (WVAR (w, buffer))) + if (current_buffer != XBUFFER (w->buffer)) abort (); if (!NILP (Vwindow_scroll_functions)) { run_hook_with_args_2 (Qwindow_scroll_functions, window, make_number (CHARPOS (startp))); - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); /* In case the hook functions switch buffers. */ - if (current_buffer != XBUFFER (WVAR (w, buffer))) - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + if (current_buffer != XBUFFER (w->buffer)) + set_buffer_internal_1 (XBUFFER (w->buffer)); } return startp; @@ -14668,7 +14666,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, int temp_scroll_step, int last_line_misfit) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct text_pos pos, startp; struct it it; int this_scroll_margin, scroll_max, rc, height; @@ -14682,7 +14680,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, debug_method_add (w, "try_scrolling"); #endif - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); /* Compute scroll margin height in pixels. We scroll when point is within this distance from the top or bottom of the window. */ @@ -14908,7 +14906,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, if (!just_this_one_p || current_buffer->clip_changed || BEG_UNCHANGED < CHARPOS (startp)) - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_number, Qnil); /* If cursor ends up on a partially visible line, treat that as being off the bottom of the screen. */ @@ -14943,7 +14941,7 @@ compute_window_start_on_continuation_line (struct window *w) struct text_pos pos, start_pos; int window_start_changed_p = 0; - SET_TEXT_POS_FROM_MARKER (start_pos, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start_pos, w->start); /* If window start is on a continuation line... Window start may be < BEGV in case there's invisible text at the start of the @@ -14991,7 +14989,7 @@ compute_window_start_on_continuation_line (struct window *w) } /* Set the window start there. */ - SET_MARKER_FROM_TEXT_POS (WVAR (w, start), pos); + SET_MARKER_FROM_TEXT_POS (w->start, pos); window_start_changed_p = 1; } } @@ -15027,7 +15025,7 @@ static int try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_step) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int rc = CURSOR_MOVEMENT_CANNOT_BE_USED; #ifdef GLYPH_DEBUG @@ -15058,7 +15056,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste set the cursor. */ && !(!NILP (Vtransient_mark_mode) && !NILP (BVAR (current_buffer, mark_active))) - && NILP (WVAR (w, region_showing)) + && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) /* This code is not used for mini-buffer for the sake of the case of redisplaying to replace an echo area message; since in @@ -15072,8 +15070,8 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste larger than the window. This should really be fixed in window.c. I don't have this on my list, now, so we do approximately the same as the old redisplay code. --gerd. */ - && INTEGERP (WVAR (w, window_end_vpos)) - && XFASTINT (WVAR (w, window_end_vpos)) < w->current_matrix->nrows + && INTEGERP (w->window_end_vpos) + && XFASTINT (w->window_end_vpos) < w->current_matrix->nrows && (FRAME_WINDOW_P (f) || !overlay_arrow_in_current_buffer_p ())) { @@ -15210,7 +15208,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste must_scroll = 1; } else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering))) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { struct glyph_row *row1; @@ -15273,7 +15271,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste else if (scroll_p) rc = CURSOR_MOVEMENT_MUST_SCROLL; else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering))) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { /* With bidi-reordered rows, there could be more than one candidate row whose start and end positions @@ -15380,12 +15378,12 @@ set_vertical_scroll_bar (struct window *w) || (w == XWINDOW (minibuf_window) && NILP (echo_area_buffer[0]))) { - struct buffer *buf = XBUFFER (WVAR (w, buffer)); + struct buffer *buf = XBUFFER (w->buffer); whole = BUF_ZV (buf) - BUF_BEGV (buf); - start = marker_position (WVAR (w, start)) - BUF_BEGV (buf); + start = marker_position (w->start) - BUF_BEGV (buf); /* I don't think this is guaranteed to be right. For the moment, we'll pretend it is. */ - end = BUF_Z (buf) - XFASTINT (WVAR (w, window_end_pos)) - BUF_BEGV (buf); + end = BUF_Z (buf) - XFASTINT (w->window_end_pos) - BUF_BEGV (buf); if (end < start) end = start; @@ -15396,8 +15394,8 @@ set_vertical_scroll_bar (struct window *w) start = end = whole = 0; /* Indicate what this scroll bar ought to be displaying now. */ - if (FRAME_TERMINAL (XFRAME (WVAR (w, frame)))->set_vertical_scroll_bar_hook) - (*FRAME_TERMINAL (XFRAME (WVAR (w, frame)))->set_vertical_scroll_bar_hook) + if (FRAME_TERMINAL (XFRAME (w->frame))->set_vertical_scroll_bar_hook) + (*FRAME_TERMINAL (XFRAME (w->frame))->set_vertical_scroll_bar_hook) (w, end - start, whole, start); } @@ -15413,8 +15411,8 @@ static void redisplay_window (Lisp_Object window, int just_this_one_p) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); - struct buffer *buffer = XBUFFER (WVAR (w, buffer)); + struct frame *f = XFRAME (w->frame); + struct buffer *buffer = XBUFFER (w->buffer); struct buffer *old = current_buffer; struct text_pos lpoint, opoint, startp; int update_mode_line; @@ -15437,7 +15435,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) opoint = lpoint; /* W must be a leaf window here. */ - eassert (!NILP (WVAR (w, buffer))); + eassert (!NILP (w->buffer)); #ifdef GLYPH_DEBUG *w->desired_matrix->method = 0; #endif @@ -15467,10 +15465,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) else if ((w != XWINDOW (minibuf_window) || minibuf_level == 0) /* When buffer is nonempty, redisplay window normally. */ - && BUF_Z (XBUFFER (WVAR (w, buffer))) == BUF_BEG (XBUFFER (WVAR (w, buffer))) + && BUF_Z (XBUFFER (w->buffer)) == BUF_BEG (XBUFFER (w->buffer)) /* Quail displays non-mini buffers in minibuffer window. In that case, redisplay the window normally. */ - && !NILP (Fmemq (WVAR (w, buffer), Vminibuffer_list))) + && !NILP (Fmemq (w->buffer, Vminibuffer_list))) { /* W is a mini-buffer window, but it's not active, so clear it. */ @@ -15492,10 +15490,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) value. */ /* Really select the buffer, for the sake of buffer-local variables. */ - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + set_buffer_internal_1 (XBUFFER (w->buffer)); current_matrix_up_to_date_p - = (!NILP (WVAR (w, window_end_valid)) + = (!NILP (w->window_end_valid) && !current_buffer->clip_changed && !current_buffer->prevent_redisplay_optimizations_p && w->last_modified >= MODIFF @@ -15519,7 +15517,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) specbind (Qinhibit_point_motion_hooks, Qt); buffer_unchanged_p - = (!NILP (WVAR (w, window_end_valid)) + = (!NILP (w->window_end_valid) && !current_buffer->clip_changed && w->last_modified >= MODIFF && w->last_overlay_modified >= OVERLAY_MODIFF); @@ -15530,10 +15528,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) { /* If window starts on a continuation line, maybe adjust the window start in case the window's width changed. */ - if (XMARKER (WVAR (w, start))->buffer == current_buffer) + if (XMARKER (w->start)->buffer == current_buffer) compute_window_start_on_continuation_line (w); - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); } /* Some sanity checks. */ @@ -15544,13 +15542,13 @@ redisplay_window (Lisp_Object window, int just_this_one_p) abort (); /* If %c is in mode line, update it if needed. */ - if (!NILP (WVAR (w, column_number_displayed)) + if (!NILP (w->column_number_displayed) /* This alternative quickly identifies a common case where no change is needed. */ && !(PT == w->last_point && w->last_modified >= MODIFF && w->last_overlay_modified >= OVERLAY_MODIFF) - && (XFASTINT (WVAR (w, column_number_displayed)) != current_column ())) + && (XFASTINT (w->column_number_displayed) != current_column ())) update_mode_line = 1; /* Count number of windows showing the selected buffer. An indirect @@ -15559,7 +15557,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) { struct buffer *current_base, *window_base; current_base = current_buffer; - window_base = XBUFFER (WVAR (XWINDOW (selected_window), buffer)); + window_base = XBUFFER (XWINDOW (selected_window)->buffer); if (current_base->base_buffer) current_base = current_base->base_buffer; if (window_base->base_buffer) @@ -15572,19 +15570,19 @@ redisplay_window (Lisp_Object window, int just_this_one_p) window, set up appropriate value. */ if (!EQ (window, selected_window)) { - ptrdiff_t new_pt = XMARKER (WVAR (w, pointm))->charpos; - ptrdiff_t new_pt_byte = marker_byte_position (WVAR (w, pointm)); + ptrdiff_t new_pt = XMARKER (w->pointm)->charpos; + ptrdiff_t new_pt_byte = marker_byte_position (w->pointm); if (new_pt < BEGV) { new_pt = BEGV; new_pt_byte = BEGV_BYTE; - set_marker_both (WVAR (w, pointm), Qnil, BEGV, BEGV_BYTE); + set_marker_both (w->pointm, Qnil, BEGV, BEGV_BYTE); } else if (new_pt > (ZV - 1)) { new_pt = ZV; new_pt_byte = ZV_BYTE; - set_marker_both (WVAR (w, pointm), Qnil, ZV, ZV_BYTE); + set_marker_both (w->pointm, Qnil, ZV, ZV_BYTE); } /* We don't use SET_PT so that the point-motion hooks don't run. */ @@ -15611,10 +15609,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) } /* If window-start is screwed up, choose a new one. */ - if (XMARKER (WVAR (w, start))->buffer != current_buffer) + if (XMARKER (w->start)->buffer != current_buffer) goto recenter; - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); /* If someone specified a new starting point but did not insist, check whether it can be used. */ @@ -15644,11 +15642,11 @@ redisplay_window (Lisp_Object window, int just_this_one_p) w->force_start = 0; w->vscroll = 0; - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); /* Forget any recorded base line for line number display. */ if (!buffer_unchanged_p) - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_number, Qnil); /* Redisplay the mode line. Select the buffer properly for that. Also, run the hook window-scroll-functions @@ -15713,7 +15711,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) MATRIX_ROW_START_BYTEPOS (row)); if (w != XWINDOW (selected_window)) - set_marker_both (WVAR (w, pointm), Qnil, PT, PT_BYTE); + set_marker_both (w->pointm, Qnil, PT, PT_BYTE); else if (current_buffer == old) SET_TEXT_POS (lpoint, PT, PT_BYTE); @@ -15815,7 +15813,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) sets it. So, we need to check the return value of compute_window_start_on_continuation_line. (See also bug#197). */ - && XMARKER (WVAR (w, start))->buffer == current_buffer + && XMARKER (w->start)->buffer == current_buffer && compute_window_start_on_continuation_line (w) /* It doesn't make sense to force the window start like we do at label force_start if it is already known that point @@ -15826,7 +15824,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) && pos_visible_p (w, PT, &d1, &d2, &d3, &d4, &d5, &d6)) { w->force_start = 1; - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); goto force_start; } @@ -15862,7 +15860,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) || current_buffer->clip_changed || BEG_UNCHANGED < CHARPOS (startp)) /* Forget any recorded base line for line number display. */ - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_number, Qnil); if (!cursor_row_fully_visible_p (w, 1, 0)) { @@ -15933,7 +15931,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) /* Forget any previously recorded base line for line number display. */ if (!buffer_unchanged_p) - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_number, Qnil); /* Determine the window start relative to point. */ init_iterator (&it, w, PT, PT_BYTE, NULL, DEFAULT_FACE_ID); @@ -16036,7 +16034,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) /* Set the window start position here explicitly, to avoid an infinite loop in case the functions in window-scroll-functions get errors. */ - set_marker_both (WVAR (w, start), Qnil, IT_CHARPOS (it), IT_BYTEPOS (it)); + set_marker_both (w->start, Qnil, IT_CHARPOS (it), IT_BYTEPOS (it)); /* Run scroll hooks. */ startp = run_window_scroll_functions (window, it.current.pos); @@ -16067,8 +16065,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p) line.) */ if (w->cursor.vpos < 0) { - if (!NILP (WVAR (w, window_end_valid)) - && PT >= Z - XFASTINT (WVAR (w, window_end_pos))) + if (!NILP (w->window_end_valid) + && PT >= Z - XFASTINT (w->window_end_pos)) { clear_glyph_matrix (w->desired_matrix); move_it_by_lines (&it, 1); @@ -16140,7 +16138,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) done: - SET_TEXT_POS_FROM_MARKER (startp, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (startp, w->start); w->start_at_line_beg = (CHARPOS (startp) == BEGV || FETCH_BYTE (BYTEPOS (startp) - 1) == '\n'); @@ -16154,10 +16152,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) && !FRAME_WINDOW_P (f) && !WINDOW_FULL_WIDTH_P (w)) /* Line number to display. */ - || INTEGERP (WVAR (w, base_line_pos)) + || INTEGERP (w->base_line_pos) /* Column number is displayed and different from the one displayed. */ - || (!NILP (WVAR (w, column_number_displayed)) - && (XFASTINT (WVAR (w, column_number_displayed)) != current_column ()))) + || (!NILP (w->column_number_displayed) + && (XFASTINT (w->column_number_displayed) != current_column ()))) /* This means that the window has a mode line. */ && (WINDOW_WANTS_MODELINE_P (w) || WINDOW_WANTS_HEADER_LINE_P (w))) @@ -16189,10 +16187,10 @@ redisplay_window (Lisp_Object window, int just_this_one_p) } if (!line_number_displayed - && !BUFFERP (WVAR (w, base_line_pos))) + && !BUFFERP (w->base_line_pos)) { - WVAR (w, base_line_pos) = Qnil; - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_pos, Qnil); + WSET (w, base_line_number, Qnil); } finish_menu_bars: @@ -16225,7 +16223,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if (FRAME_EXTERNAL_TOOL_BAR (f)) redisplay_tool_bar (f); #else - if (WINDOWP (FVAR (f, tool_bar_window)) + if (WINDOWP (f->tool_bar_window) && (FRAME_TOOL_BAR_LINES (f) > 0 || !NILP (Vauto_resize_tool_bars)) && redisplay_tool_bar (f)) @@ -16305,10 +16303,10 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) struct window *w = XWINDOW (window); struct it it; struct glyph_row *last_text_row = NULL; - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); /* Make POS the new window start. */ - set_marker_both (WVAR (w, start), Qnil, CHARPOS (pos), BYTEPOS (pos)); + set_marker_both (w->start, Qnil, CHARPOS (pos), BYTEPOS (pos)); /* Mark cursor position as unknown. No overlay arrow seen. */ w->cursor.vpos = -1; @@ -16364,7 +16362,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) } /* If bottom moved off end of frame, change mode line percentage. */ - if (XFASTINT (WVAR (w, window_end_pos)) <= 0 + if (XFASTINT (w->window_end_pos) <= 0 && Z != IT_CHARPOS (it)) w->update_mode_line = 1; @@ -16376,23 +16374,23 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) eassert (MATRIX_ROW_DISPLAYS_TEXT_P (last_text_row)); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row); - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row))); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix))); eassert (MATRIX_ROW (w->desired_matrix, - XFASTINT (WVAR (w, window_end_vpos)))->displays_text_p); + XFASTINT (w->window_end_vpos))->displays_text_p); } else { w->window_end_bytepos = Z_BYTE - ZV_BYTE; - WVAR (w, window_end_pos) = make_number (Z - ZV); - WVAR (w, window_end_vpos) = make_number (0); + WSET (w, window_end_pos, make_number (Z - ZV)); + WSET (w, window_end_vpos, make_number (0)); } /* But that is not valid info until redisplay finishes. */ - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); return 1; } @@ -16410,7 +16408,7 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) static int try_window_reusing_current_matrix (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph_row *bottom_row; struct it it; struct run run; @@ -16444,7 +16442,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't do this if region may have changed. */ if ((!NILP (Vtransient_mark_mode) && !NILP (BVAR (current_buffer, mark_active))) - || !NILP (WVAR (w, region_showing)) + || !NILP (w->region_showing) || !NILP (Vshow_trailing_whitespace)) return 0; @@ -16461,7 +16459,7 @@ try_window_reusing_current_matrix (struct window *w) /* The variable new_start now holds the new window start. The old start `start' can be determined from the current matrix. */ - SET_TEXT_POS_FROM_MARKER (new_start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (new_start, w->start); start = start_row->minpos; start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix); @@ -16623,29 +16621,28 @@ try_window_reusing_current_matrix (struct window *w) { w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_reused_text_row); - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_reused_text_row)); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_reused_text_row, - w->current_matrix)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_reused_text_row))); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_reused_text_row, w->current_matrix))); } else if (last_text_row) { w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row); - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row))); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix))); } else { /* This window must be completely empty. */ w->window_end_bytepos = Z_BYTE - ZV_BYTE; - WVAR (w, window_end_pos) = make_number (Z - ZV); - WVAR (w, window_end_vpos) = make_number (0); + WSET (w, window_end_pos, make_number (Z - ZV)); + WSET (w, window_end_vpos, make_number (0)); } - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); /* Update hint: don't try scrolling again in update_window. */ w->desired_matrix->no_scrolling_p = 1; @@ -16799,7 +16796,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't use this optimization with bidi-reordered glyph rows, unless cursor is already at point. */ - if (!NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { if (!(w->cursor.hpos >= 0 && w->cursor.hpos < row->used[TEXT_AREA] @@ -16826,18 +16823,18 @@ try_window_reusing_current_matrix (struct window *w) { w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row); - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row))); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_text_row, w->desired_matrix))); } else { - WVAR (w, window_end_vpos) - = make_number (XFASTINT (WVAR (w, window_end_vpos)) - nrows_scrolled); + WSET (w, window_end_vpos, + make_number (XFASTINT (w->window_end_vpos) - nrows_scrolled)); } - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); w->desired_matrix->no_scrolling_p = 1; #ifdef GLYPH_DEBUG @@ -16970,16 +16967,16 @@ find_first_unchanged_at_end_row (struct window *w, /* Display must not have been paused, otherwise the current matrix is not up to date. */ - eassert (!NILP (WVAR (w, window_end_valid))); + eassert (!NILP (w->window_end_valid)); /* A value of window_end_pos >= END_UNCHANGED means that the window end is in the range of changed text. If so, there is no unchanged row at the end of W's current matrix. */ - if (XFASTINT (WVAR (w, window_end_pos)) >= END_UNCHANGED) + if (XFASTINT (w->window_end_pos) >= END_UNCHANGED) return NULL; /* Set row to the last row in W's current matrix displaying text. */ - row = MATRIX_ROW (w->current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); /* If matrix is entirely empty, no unchanged row exists. */ if (MATRIX_ROW_DISPLAYS_TEXT_P (row)) @@ -16990,7 +16987,7 @@ find_first_unchanged_at_end_row (struct window *w, buffer positions in the current matrix to current buffer positions for characters not in changed text. */ ptrdiff_t Z_old = - MATRIX_ROW_END_CHARPOS (row) + XFASTINT (WVAR (w, window_end_pos)); + MATRIX_ROW_END_CHARPOS (row) + XFASTINT (w->window_end_pos); ptrdiff_t Z_BYTE_old = MATRIX_ROW_END_BYTEPOS (row) + w->window_end_bytepos; ptrdiff_t last_unchanged_pos, last_unchanged_pos_old; @@ -17038,12 +17035,12 @@ find_first_unchanged_at_end_row (struct window *w, static void sync_frame_with_window_matrix_rows (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph_row *window_row, *window_row_end, *frame_row; /* Preconditions: W must be a leaf window and full-width. Its frame must have a frame matrix. */ - eassert (NILP (WVAR (w, hchild)) && NILP (WVAR (w, vchild))); + eassert (NILP (w->hchild) && NILP (w->vchild)); eassert (WINDOW_FULL_WIDTH_P (w)); eassert (!FRAME_WINDOW_P (f)); @@ -17085,7 +17082,7 @@ row_containing_pos (struct window *w, ptrdiff_t charpos, { struct glyph_row *row = start; struct glyph_row *best_row = NULL; - ptrdiff_t mindif = BUF_ZV (XBUFFER (WVAR (w, buffer))) + 1; + ptrdiff_t mindif = BUF_ZV (XBUFFER (w->buffer)) + 1; int last_y; /* If we happen to start on a header-line, skip that. */ @@ -17121,7 +17118,7 @@ row_containing_pos (struct window *w, ptrdiff_t charpos, { struct glyph *g; - if (NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering)) + if (NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) || (!best_row && !row->continued_p)) return row; /* In bidi-reordered rows, there could be several rows @@ -17190,7 +17187,7 @@ row_containing_pos (struct window *w, ptrdiff_t charpos, static int try_window_id (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph_matrix *current_matrix = w->current_matrix; struct glyph_matrix *desired_matrix = w->desired_matrix; struct glyph_row *last_unchanged_at_beg_row; @@ -17231,7 +17228,7 @@ try_window_id (struct window *w) #define GIVE_UP(X) return 0 #endif - SET_TEXT_POS_FROM_MARKER (start, WVAR (w, start)); + SET_TEXT_POS_FROM_MARKER (start, w->start); /* Don't use this for mini-windows because these can show messages and mini-buffers, and we don't handle that here. */ @@ -17269,7 +17266,7 @@ try_window_id (struct window *w) GIVE_UP (7); /* Verify that display wasn't paused. */ - if (NILP (WVAR (w, window_end_valid))) + if (NILP (w->window_end_valid)) GIVE_UP (8); /* Can't use this if highlighting a region because a cursor movement @@ -17283,7 +17280,7 @@ try_window_id (struct window *w) GIVE_UP (11); /* Likewise if showing a region. */ - if (!NILP (WVAR (w, region_showing))) + if (!NILP (w->region_showing)) GIVE_UP (10); /* Can't use this if overlay arrow position and/or string have @@ -17295,7 +17292,7 @@ try_window_id (struct window *w) wrapped line can change the wrap position, altering the line above it. It might be worthwhile to handle this more intelligently, but for now just redisplay from scratch. */ - if (!NILP (BVAR (XBUFFER (WVAR (w, buffer)), word_wrap))) + if (!NILP (BVAR (XBUFFER (w->buffer), word_wrap))) GIVE_UP (21); /* Under bidi reordering, adding or deleting a character in the @@ -17306,8 +17303,8 @@ try_window_id (struct window *w) to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization and redisplay from scratch. */ - if (!NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_display_reordering)) - && NILP (BVAR (XBUFFER (WVAR (w, buffer)), bidi_paragraph_direction))) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) GIVE_UP (22); /* Make sure beg_unchanged and end_unchanged are up to date. Do it @@ -17333,7 +17330,7 @@ try_window_id (struct window *w) This case happens with stealth-fontification. Note that although the display is unchanged, glyph positions in the matrix have to be adjusted, of course. */ - row = MATRIX_ROW (w->current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + row = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); if (MATRIX_ROW_DISPLAYS_TEXT_P (row) && ((last_changed_charpos < CHARPOS (start) && CHARPOS (start) == BEGV) @@ -17345,7 +17342,7 @@ try_window_id (struct window *w) /* Compute how many chars/bytes have been added to or removed from the buffer. */ - Z_old = MATRIX_ROW_END_CHARPOS (row) + XFASTINT (WVAR (w, window_end_pos)); + Z_old = MATRIX_ROW_END_CHARPOS (row) + XFASTINT (w->window_end_pos); Z_BYTE_old = MATRIX_ROW_END_BYTEPOS (row) + w->window_end_bytepos; Z_delta = Z - Z_old; Z_delta_bytes = Z_BYTE - Z_BYTE_old; @@ -17416,8 +17413,8 @@ try_window_id (struct window *w) { /* We have to compute the window end anew since text could have been added/removed after it. */ - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (row)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (row))); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row); @@ -17452,7 +17449,7 @@ try_window_id (struct window *w) /* Give up if the window ends in strings. Overlay strings at the end are difficult to handle, so don't try. */ - row = MATRIX_ROW (current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + row = MATRIX_ROW (current_matrix, XFASTINT (w->window_end_vpos)); if (MATRIX_ROW_START_CHARPOS (row) == MATRIX_ROW_END_CHARPOS (row)) GIVE_UP (20); @@ -17795,7 +17792,7 @@ try_window_id (struct window *w) /* Set last_row to the glyph row in the current matrix where the window end line is found. It has been moved up or down in the matrix by dvpos. */ - int last_vpos = XFASTINT (WVAR (w, window_end_vpos)) + dvpos; + int last_vpos = XFASTINT (w->window_end_vpos) + dvpos; struct glyph_row *last_row = MATRIX_ROW (current_matrix, last_vpos); /* If last_row is the window end line, it should display text. */ @@ -17851,21 +17848,21 @@ try_window_id (struct window *w) first_unchanged_at_end_row); eassert (row && MATRIX_ROW_DISPLAYS_TEXT_P (row)); - WVAR (w, window_end_pos) = make_number (Z - MATRIX_ROW_END_CHARPOS (row)); + WSET (w, window_end_pos, make_number (Z - MATRIX_ROW_END_CHARPOS (row))); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (row, w->current_matrix)); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (row, w->current_matrix))); eassert (w->window_end_bytepos >= 0); IF_DEBUG (debug_method_add (w, "A")); } else if (last_text_row_at_end) { - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row_at_end)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row_at_end))); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row_at_end); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_text_row_at_end, desired_matrix)); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_text_row_at_end, desired_matrix))); eassert (w->window_end_bytepos >= 0); IF_DEBUG (debug_method_add (w, "B")); } @@ -17874,12 +17871,12 @@ try_window_id (struct window *w) /* We have displayed either to the end of the window or at the end of the window, i.e. the last row with text is to be found in the desired matrix. */ - WVAR (w, window_end_pos) - = make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row)); + WSET (w, window_end_pos, + make_number (Z - MATRIX_ROW_END_CHARPOS (last_text_row))); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (last_text_row); - WVAR (w, window_end_vpos) - = make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix)); + WSET (w, window_end_vpos, + make_number (MATRIX_ROW_VPOS (last_text_row, desired_matrix))); eassert (w->window_end_bytepos >= 0); } else if (first_unchanged_at_end_row == NULL @@ -17889,7 +17886,7 @@ try_window_id (struct window *w) /* Displayed to end of window, but no line containing text was displayed. Lines were deleted at the end of the window. */ int first_vpos = WINDOW_WANTS_HEADER_LINE_P (w) ? 1 : 0; - int vpos = XFASTINT (WVAR (w, window_end_vpos)); + int vpos = XFASTINT (w->window_end_vpos); struct glyph_row *current_row = current_matrix->rows + vpos; struct glyph_row *desired_row = desired_matrix->rows + vpos; @@ -17907,8 +17904,8 @@ try_window_id (struct window *w) } eassert (row != NULL); - WVAR (w, window_end_vpos) = make_number (vpos + 1); - WVAR (w, window_end_pos) = make_number (Z - MATRIX_ROW_END_CHARPOS (row)); + WSET (w, window_end_vpos, make_number (vpos + 1)); + WSET (w, window_end_pos, make_number (Z - MATRIX_ROW_END_CHARPOS (row))); w->window_end_bytepos = Z_BYTE - MATRIX_ROW_END_BYTEPOS (row); eassert (w->window_end_bytepos >= 0); IF_DEBUG (debug_method_add (w, "C")); @@ -17920,7 +17917,7 @@ try_window_id (struct window *w) debug_end_vpos = XFASTINT (w->window_end_vpos)); /* Record that display has not been completed. */ - WVAR (w, window_end_valid) = Qnil; + WSET (w, window_end_valid, Qnil); w->desired_matrix->no_scrolling_p = 1; return 3; @@ -18173,7 +18170,7 @@ glyphs in short form, otherwise show glyphs in long form. */) (Lisp_Object glyphs) { struct window *w = XWINDOW (selected_window); - struct buffer *buffer = XBUFFER (WVAR (w, buffer)); + struct buffer *buffer = XBUFFER (w->buffer); fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n", BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer)); @@ -18225,7 +18222,7 @@ GLYPH > 1 or omitted means dump glyphs in long form. */) (Lisp_Object row, Lisp_Object glyphs) { struct frame *sf = SELECTED_FRAME (); - struct glyph_matrix *m = XWINDOW (FVAR (sf, tool_bar_window))->current_matrix; + struct glyph_matrix *m = XWINDOW (sf->tool_bar_window)->current_matrix; EMACS_INT vpos; CHECK_NUMBER (row); @@ -18279,7 +18276,7 @@ static struct glyph_row * get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) { struct frame *f = XFRAME (WINDOW_FRAME (w)); - struct buffer *buffer = XBUFFER (WVAR (w, buffer)); + struct buffer *buffer = XBUFFER (w->buffer); struct buffer *old = current_buffer; const unsigned char *arrow_string = SDATA (overlay_arrow_string); int arrow_len = SCHARS (overlay_arrow_string); @@ -19356,7 +19353,7 @@ display_line (struct it *it) } /* Is IT->w showing the region? */ - WVAR (it->w, region_showing) = it->region_beg_charpos > 0 ? Qt : Qnil; + WSET (it->w, region_showing, it->region_beg_charpos > 0 ? Qt : Qnil); /* Clear the result glyph row and enable it. */ prepare_desired_row (row); @@ -19471,7 +19468,7 @@ display_line (struct it *it) row->glyphs[TEXT_AREA]->charpos = -1; row->displays_text_p = 0; - if (!NILP (BVAR (XBUFFER (WVAR (it->w, buffer)), indicate_empty_lines)) + if (!NILP (BVAR (XBUFFER (it->w->buffer), indicate_empty_lines)) && (!MINI_WINDOW_P (it->w) || (minibuf_level && EQ (it->window, minibuf_window)))) row->indicate_empty_line_p = 1; @@ -20210,8 +20207,8 @@ display_menu_bar (struct window *w) /* Menu bar lines are displayed in the desired matrix of the dummy window menu_bar_window. */ struct window *menu_w; - eassert (WINDOWP (FVAR (f, menu_bar_window))); - menu_w = XWINDOW (FVAR (f, menu_bar_window)); + eassert (WINDOWP (f->menu_bar_window)); + menu_w = XWINDOW (f->menu_bar_window); init_iterator (&it, menu_w, -1, -1, menu_w->desired_matrix->rows, MENU_FACE_ID); it.first_visible_x = 0; @@ -20294,12 +20291,12 @@ redisplay_mode_lines (Lisp_Object window, int force) { struct window *w = XWINDOW (window); - if (WINDOWP (WVAR (w, hchild))) - nwindows += redisplay_mode_lines (WVAR (w, hchild), force); - else if (WINDOWP (WVAR (w, vchild))) - nwindows += redisplay_mode_lines (WVAR (w, vchild), force); + if (WINDOWP (w->hchild)) + nwindows += redisplay_mode_lines (w->hchild, force); + else if (WINDOWP (w->vchild)) + nwindows += redisplay_mode_lines (w->vchild, force); else if (force - || FRAME_GARBAGED_P (XFRAME (WVAR (w, frame))) + || FRAME_GARBAGED_P (XFRAME (w->frame)) || !MATRIX_MODE_LINE_ROW (w->current_matrix)->enabled_p) { struct text_pos lpoint; @@ -20307,7 +20304,7 @@ redisplay_mode_lines (Lisp_Object window, int force) /* Set the window's buffer for the mode line display. */ SET_TEXT_POS (lpoint, PT, PT_BYTE); - set_buffer_internal_1 (XBUFFER (WVAR (w, buffer))); + set_buffer_internal_1 (XBUFFER (w->buffer)); /* Point refers normally to the selected window. For any other window, set up appropriate value. */ @@ -20315,7 +20312,7 @@ redisplay_mode_lines (Lisp_Object window, int force) { struct text_pos pt; - SET_TEXT_POS_FROM_MARKER (pt, WVAR (w, pointm)); + SET_TEXT_POS_FROM_MARKER (pt, w->pointm); if (CHARPOS (pt) < BEGV) TEMP_SET_PT_BOTH (BEGV, BEGV_BYTE); else if (CHARPOS (pt) > (ZV - 1)) @@ -20337,7 +20334,7 @@ redisplay_mode_lines (Lisp_Object window, int force) TEMP_SET_PT_BOTH (CHARPOS (lpoint), BYTEPOS (lpoint)); } - window = WVAR (w, next); + window = w->next; } return nwindows; @@ -20354,13 +20351,13 @@ display_mode_lines (struct window *w) int n = 0; old_selected_frame = selected_frame; - selected_frame = WVAR (w, frame); + selected_frame = w->frame; old_selected_window = selected_window; XSETWINDOW (selected_window, w); /* These will be set while the mode line specs are processed. */ line_number_displayed = 0; - WVAR (w, column_number_displayed) = Qnil; + WSET (w, column_number_displayed, Qnil); if (WINDOW_WANTS_MODELINE_P (w)) { @@ -21090,7 +21087,7 @@ are the selected window and the WINDOW's buffer). */) w = XWINDOW (window); if (NILP (buffer)) - buffer = WVAR (w, buffer); + buffer = w->buffer; CHECK_BUFFER (buffer); /* Make formatting the modeline a non-op when noninteractive, otherwise @@ -21496,7 +21493,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, else { ptrdiff_t col = current_column (); - WVAR (w, column_number_displayed) = make_number (col); + WSET (w, column_number_displayed, make_number (col)); pint2str (decode_mode_spec_buf, field_width, col); return decode_mode_spec_buf; } @@ -21515,10 +21512,10 @@ decode_mode_spec (struct window *w, register int c, int field_width, case 'F': /* %F displays the frame name. */ - if (!NILP (FVAR (f, title))) - return SSDATA (FVAR (f, title)); + if (!NILP (f->title)) + return SSDATA (f->title); if (f->explicit_name || ! FRAME_WINDOW_P (f)) - return SSDATA (FVAR (f, name)); + return SSDATA (f->name); return "Emacs"; case 'f': @@ -21549,33 +21546,33 @@ decode_mode_spec (struct window *w, register int c, int field_width, if (mode_line_target == MODE_LINE_TITLE) return ""; - startpos = XMARKER (WVAR (w, start))->charpos; - startpos_byte = marker_byte_position (WVAR (w, start)); + startpos = XMARKER (w->start)->charpos; + startpos_byte = marker_byte_position (w->start); height = WINDOW_TOTAL_LINES (w); /* If we decided that this buffer isn't suitable for line numbers, don't forget that too fast. */ - if (EQ (WVAR (w, base_line_pos), WVAR (w, buffer))) + if (EQ (w->base_line_pos, w->buffer)) goto no_value; /* But do forget it, if the window shows a different buffer now. */ - else if (BUFFERP (WVAR (w, base_line_pos))) - WVAR (w, base_line_pos) = Qnil; + else if (BUFFERP (w->base_line_pos)) + WSET (w, base_line_pos, Qnil); /* If the buffer is very big, don't waste time. */ if (INTEGERP (Vline_number_display_limit) && BUF_ZV (b) - BUF_BEGV (b) > XINT (Vline_number_display_limit)) { - WVAR (w, base_line_pos) = Qnil; - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_pos, Qnil); + WSET (w, base_line_number, Qnil); goto no_value; } - if (INTEGERP (WVAR (w, base_line_number)) - && INTEGERP (WVAR (w, base_line_pos)) - && XFASTINT (WVAR (w, base_line_pos)) <= startpos) + if (INTEGERP (w->base_line_number) + && INTEGERP (w->base_line_pos) + && XFASTINT (w->base_line_pos) <= startpos) { - line = XFASTINT (WVAR (w, base_line_number)); - linepos = XFASTINT (WVAR (w, base_line_pos)); + line = XFASTINT (w->base_line_number); + linepos = XFASTINT (w->base_line_pos); linepos_byte = buf_charpos_to_bytepos (b, linepos); } else @@ -21598,8 +21595,8 @@ decode_mode_spec (struct window *w, register int c, int field_width, go back past it. */ if (startpos == BUF_BEGV (b)) { - WVAR (w, base_line_number) = make_number (topline); - WVAR (w, base_line_pos) = make_number (BUF_BEGV (b)); + WSET (w, base_line_number, make_number (topline)); + WSET (w, base_line_pos, make_number (BUF_BEGV (b))); } else if (nlines < height + 25 || nlines > height * 3 + 50 || linepos == BUF_BEGV (b)) @@ -21625,13 +21622,13 @@ decode_mode_spec (struct window *w, register int c, int field_width, give up on line numbers for this window. */ if (position == limit_byte && limit == startpos - distance) { - WVAR (w, base_line_pos) = WVAR (w, buffer); - WVAR (w, base_line_number) = Qnil; + WSET (w, base_line_pos, w->buffer); + WSET (w, base_line_number, Qnil); goto no_value; } - WVAR (w, base_line_number) = make_number (topline - nlines); - WVAR (w, base_line_pos) = make_number (BYTE_TO_CHAR (position)); + WSET (w, base_line_number, make_number (topline - nlines)); + WSET (w, base_line_pos, make_number (BYTE_TO_CHAR (position))); } /* Now count lines from the start pos to point. */ @@ -21669,10 +21666,10 @@ decode_mode_spec (struct window *w, register int c, int field_width, case 'p': { - ptrdiff_t pos = marker_position (WVAR (w, start)); + ptrdiff_t pos = marker_position (w->start); ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b); - if (XFASTINT (WVAR (w, window_end_pos)) <= BUF_Z (b) - BUF_ZV (b)) + if (XFASTINT (w->window_end_pos) <= BUF_Z (b) - BUF_ZV (b)) { if (pos <= BUF_BEGV (b)) return "All"; @@ -21700,8 +21697,8 @@ decode_mode_spec (struct window *w, register int c, int field_width, /* Display percentage of size above the bottom of the screen. */ case 'P': { - ptrdiff_t toppos = marker_position (WVAR (w, start)); - ptrdiff_t botpos = BUF_Z (b) - XFASTINT (WVAR (w, window_end_pos)); + ptrdiff_t toppos = marker_position (w->start); + ptrdiff_t botpos = BUF_Z (b) - XFASTINT (w->window_end_pos); ptrdiff_t total = BUF_ZV (b) - BUF_BEGV (b); if (botpos >= BUF_ZV (b)) @@ -21784,9 +21781,9 @@ decode_mode_spec (struct window *w, register int c, int field_width, if (PROCESSP (obj)) { p = decode_mode_spec_coding - (PVAR (XPROCESS (obj), decode_coding_system), p, eol_flag); + (XPROCESS (obj)->decode_coding_system, p, eol_flag); p = decode_mode_spec_coding - (PVAR (XPROCESS (obj), encode_coding_system), p, eol_flag); + (XPROCESS (obj)->encode_coding_system, p, eol_flag); } #endif /* subprocesses */ #endif /* 0 */ @@ -22408,7 +22405,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, return OK_PIXELS (WINDOW_SCROLL_BAR_AREA_WIDTH (it->w)); } - prop = buffer_local_value_1 (prop, WVAR (it->w, buffer)); + prop = buffer_local_value_1 (prop, it->w->buffer); if (EQ (prop, Qunbound)) prop = Qnil; } @@ -22467,7 +22464,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop, return OK_PIXELS (pixels); } - car = buffer_local_value_1 (car, WVAR (it->w, buffer)); + car = buffer_local_value_1 (car, it->w->buffer); if (EQ (car, Qunbound)) car = Qnil; } @@ -22548,7 +22545,7 @@ init_glyph_string (struct glyph_string *s, { memset (s, 0, sizeof *s); s->w = w; - s->f = XFRAME (WVAR (w, frame)); + s->f = XFRAME (w->frame); #ifdef HAVE_NTGUI s->hdc = hdc; #endif @@ -22880,7 +22877,7 @@ fill_glyph_string (struct glyph_string *s, int face_id, int voffset; int glyph_not_available_p; - eassert (s->f == XFRAME (WVAR (s->w, frame))); + eassert (s->f == XFRAME (s->w->frame)); eassert (s->nchars == 0); eassert (start >= 0 && end > start); @@ -24405,7 +24402,7 @@ produce_stretch_glyph (struct it *it) int n = width; if (!STRINGP (object)) - object = WVAR (it->w, buffer); + object = it->w->buffer; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (it->f)) append_stretch_glyph (it, object, width, height, ascent); @@ -25198,7 +25195,7 @@ x_produce_glyphs (struct it *it) font_descent = FONT_DESCENT (font) - boff; font_height = FONT_HEIGHT (font); - cmp->font = (void *) font; + cmp->font = font; pcm = NULL; if (! font_not_found_p) @@ -25635,7 +25632,7 @@ x_clear_end_of_line (int to_x) int from_x, from_y, to_y; eassert (updated_window && updated_row); - f = XFRAME (WVAR (w, frame)); + f = XFRAME (w->frame); if (updated_row->full_width_p) max_x = WINDOW_TOTAL_WIDTH (w); @@ -25793,8 +25790,8 @@ static enum text_cursor_kinds get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, int *active_cursor) { - struct frame *f = XFRAME (WVAR (w, frame)); - struct buffer *b = XBUFFER (WVAR (w, buffer)); + struct frame *f = XFRAME (w->frame); + struct buffer *b = XBUFFER (w->buffer); int cursor_type = DEFAULT_CURSOR; Lisp_Object alt_cursor; int non_selected = 0; @@ -25822,7 +25819,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, } /* Detect a nonselected window or nonselected frame. */ - else if (w != XWINDOW (FVAR (f, selected_window)) + else if (w != XWINDOW (f->selected_window) || f != FRAME_X_DISPLAY_INFO (f)->x_highlight_frame) { *active_cursor = 0; @@ -26112,7 +26109,7 @@ draw_phys_cursor_glyph (struct window *w, struct glyph_row *row, void erase_phys_cursor (struct window *w) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); int hpos = w->phys_cursor.hpos; int vpos = w->phys_cursor.vpos; @@ -26231,7 +26228,7 @@ void display_and_set_cursor (struct window *w, int on, int hpos, int vpos, int x, int y) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int new_cursor_type; int new_cursor_width; int active_cursor; @@ -26352,14 +26349,14 @@ update_cursor_in_window_tree (struct window *w, int on_p) { while (w) { - if (!NILP (WVAR (w, hchild))) - update_cursor_in_window_tree (XWINDOW (WVAR (w, hchild)), on_p); - else if (!NILP (WVAR (w, vchild))) - update_cursor_in_window_tree (XWINDOW (WVAR (w, vchild)), on_p); + if (!NILP (w->hchild)) + update_cursor_in_window_tree (XWINDOW (w->hchild), on_p); + else if (!NILP (w->vchild)) + update_cursor_in_window_tree (XWINDOW (w->vchild), on_p); else update_window_cursor (w, on_p); - w = NILP (WVAR (w, next)) ? 0 : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? 0 : XWINDOW (w->next); } } @@ -26371,7 +26368,7 @@ update_cursor_in_window_tree (struct window *w, int on_p) void x_update_cursor (struct frame *f, int on_p) { - update_cursor_in_window_tree (XWINDOW (FVAR (f, root_window)), on_p); + update_cursor_in_window_tree (XWINDOW (f->root_window), on_p); } @@ -26383,7 +26380,7 @@ x_update_cursor (struct frame *f, int on_p) void x_clear_cursor (struct window *w) { - if (FRAME_VISIBLE_P (XFRAME (WVAR (w, frame))) && w->phys_cursor_on_p) + if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p) update_window_cursor (w, 0); } @@ -26397,7 +26394,7 @@ draw_row_with_mouse_face (struct window *w, int start_x, struct glyph_row *row, enum draw_glyphs_face draw) { #ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (XFRAME (WVAR (w, frame)))) + if (FRAME_WINDOW_P (XFRAME (w->frame))) { draw_glyphs (w, start_x, row, TEXT_AREA, start_hpos, end_hpos, draw, 0); return; @@ -26530,7 +26527,7 @@ show_mouse_face (Mouse_HLInfo *hlinfo, enum draw_glyphs_face draw) if (FRAME_WINDOW_P (f)) { if (draw == DRAW_NORMAL_TEXT - && !EQ (hlinfo->mouse_face_window, FVAR (f, tool_bar_window))) + && !EQ (hlinfo->mouse_face_window, f->tool_bar_window)) FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->text_cursor); else if (draw == DRAW_MOUSE_FACE) FRAME_RIF (f)->define_frame_cursor (f, FRAME_X_OUTPUT (f)->hand_cursor); @@ -26568,7 +26565,7 @@ clear_mouse_face (Mouse_HLInfo *hlinfo) static int coords_in_mouse_face_p (struct window *w, int hpos, int vpos) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (WVAR (w, frame))); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); /* Quickly resolve the easy cases. */ if (!(WINDOWP (hlinfo->mouse_face_window) @@ -26820,7 +26817,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, /* Find the rows corresponding to START_CHARPOS and END_CHARPOS. */ rows_from_pos_range (w, start_charpos, end_charpos, disp_string, &r1, &r2); if (r1 == NULL) - r1 = MATRIX_ROW (w->current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + r1 = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); /* If the before-string or display-string contains newlines, rows_from_pos_range skips to its last row. Move back. */ if (!NILP (before_string) || !NILP (disp_string)) @@ -26842,7 +26839,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, } if (r2 == NULL) { - r2 = MATRIX_ROW (w->current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + r2 = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); hlinfo->mouse_face_past_end = 1; } else if (!NILP (after_string)) @@ -26850,7 +26847,7 @@ mouse_face_from_buffer_pos (Lisp_Object window, /* If the after-string has newlines, advance to its last row. */ struct glyph_row *next; struct glyph_row *last - = MATRIX_ROW (w->current_matrix, XFASTINT (WVAR (w, window_end_vpos))); + = MATRIX_ROW (w->current_matrix, XFASTINT (w->window_end_vpos)); for (next = r2 + 1; next <= last @@ -27515,7 +27512,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, enum window_part area) { struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); #ifdef HAVE_WINDOW_SYSTEM Display_Info *dpyinfo; @@ -27599,7 +27596,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, { help_echo_string = help; XSETWINDOW (help_echo_window, w); - help_echo_object = WVAR (w, buffer); + help_echo_object = w->buffer; help_echo_pos = charpos; } } @@ -27635,7 +27632,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y, { Lisp_Object default_help = buffer_local_value_1 (Qmode_line_default_help_echo, - WVAR (w, buffer)); + w->buffer); if (STRINGP (default_help)) { @@ -27886,7 +27883,7 @@ note_mouse_highlight (struct frame *f, int x, int y) #ifdef HAVE_WINDOW_SYSTEM /* Handle tool-bar window differently since it doesn't display a buffer. */ - if (EQ (window, FVAR (f, tool_bar_window))) + if (EQ (window, f->tool_bar_window)) { note_tool_bar_highlight (f, x, y); return; @@ -27916,9 +27913,9 @@ note_mouse_highlight (struct frame *f, int x, int y) /* Are we in a window whose display is up to date? And verify the buffer's text has not changed. */ - b = XBUFFER (WVAR (w, buffer)); + b = XBUFFER (w->buffer); if (part == ON_TEXT - && EQ (WVAR (w, window_end_valid), WVAR (w, buffer)) + && EQ (w->window_end_valid, w->buffer) && w->last_modified == BUF_MODIFF (b) && w->last_overlay_modified == BUF_OVERLAY_MODIFF (b)) { @@ -28125,8 +28122,8 @@ note_mouse_highlight (struct frame *f, int x, int y) if (pos > 0) { mouse_face = get_char_property_and_overlay - (make_number (pos), Qmouse_face, WVAR (w, buffer), &overlay); - buffer = WVAR (w, buffer); + (make_number (pos), Qmouse_face, w->buffer, &overlay); + buffer = w->buffer; disp_string = object; } } @@ -28152,12 +28149,12 @@ note_mouse_highlight (struct frame *f, int x, int y) is the smallest. */ Lisp_Object lim1 = NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) - ? Fmarker_position (WVAR (w, start)) + ? Fmarker_position (w->start) : Qnil; Lisp_Object lim2 = NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) ? make_number (BUF_Z (XBUFFER (buffer)) - - XFASTINT (WVAR (w, window_end_pos))) + - XFASTINT (w->window_end_pos)) : Qnil; if (NILP (overlay)) @@ -28239,11 +28236,11 @@ note_mouse_highlight (struct frame *f, int x, int y) if (p > 0) { help = Fget_char_property (make_number (p), - Qhelp_echo, WVAR (w, buffer)); + Qhelp_echo, w->buffer); if (!NILP (help)) { charpos = p; - obj = WVAR (w, buffer); + obj = w->buffer; } } } @@ -28294,7 +28291,7 @@ note_mouse_highlight (struct frame *f, int x, int y) ptrdiff_t p = string_buffer_position (obj, start); if (p > 0) pointer = Fget_char_property (make_number (p), - Qpointer, WVAR (w, buffer)); + Qpointer, w->buffer); } } else if (BUFFERP (obj) @@ -28332,7 +28329,7 @@ note_mouse_highlight (struct frame *f, int x, int y) void x_clear_window_mouse_face (struct window *w) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (WVAR (w, frame))); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); Lisp_Object window; BLOCK_INPUT; @@ -28354,7 +28351,7 @@ cancel_mouse_face (struct frame *f) Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); window = hlinfo->mouse_face_window; - if (! NILP (window) && XFRAME (WVAR (XWINDOW (window), frame)) == f) + if (! NILP (window) && XFRAME (XWINDOW (window)->frame) == f) { hlinfo->mouse_face_beg_row = hlinfo->mouse_face_beg_col = -1; hlinfo->mouse_face_end_row = hlinfo->mouse_face_end_col = -1; @@ -28548,7 +28545,7 @@ x_draw_vertical_border (struct window *w) do it for frames with vertical scroll bars because either the right scroll bar of a window, or the left scroll bar of its neighbor will suffice as a border. */ - if (FRAME_HAS_VERTICAL_SCROLL_BARS (XFRAME (WVAR (w, frame)))) + if (FRAME_HAS_VERTICAL_SCROLL_BARS (XFRAME (w->frame))) return; if (!WINDOW_RIGHTMOST_P (w) @@ -28588,7 +28585,7 @@ x_draw_vertical_border (struct window *w) static int expose_window (struct window *w, XRectangle *fr) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); XRectangle wr, r; int mouse_face_overwritten_p = 0; @@ -28729,21 +28726,21 @@ expose_window (struct window *w, XRectangle *fr) static int expose_window_tree (struct window *w, XRectangle *r) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int mouse_face_overwritten_p = 0; while (w && !FRAME_GARBAGED_P (f)) { - if (!NILP (WVAR (w, hchild))) + if (!NILP (w->hchild)) mouse_face_overwritten_p - |= expose_window_tree (XWINDOW (WVAR (w, hchild)), r); - else if (!NILP (WVAR (w, vchild))) + |= expose_window_tree (XWINDOW (w->hchild), r); + else if (!NILP (w->vchild)) mouse_face_overwritten_p - |= expose_window_tree (XWINDOW (WVAR (w, vchild)), r); + |= expose_window_tree (XWINDOW (w->vchild), r); else mouse_face_overwritten_p |= expose_window (w, r); - w = NILP (WVAR (w, next)) ? NULL : XWINDOW (WVAR (w, next)); + w = NILP (w->next) ? NULL : XWINDOW (w->next); } return mouse_face_overwritten_p; @@ -28796,18 +28793,18 @@ expose_frame (struct frame *f, int x, int y, int w, int h) } TRACE ((stderr, "(%d, %d, %d, %d)\n", r.x, r.y, r.width, r.height)); - mouse_face_overwritten_p = expose_window_tree (XWINDOW (FVAR (f, root_window)), &r); + mouse_face_overwritten_p = expose_window_tree (XWINDOW (f->root_window), &r); - if (WINDOWP (FVAR (f, tool_bar_window))) + if (WINDOWP (f->tool_bar_window)) mouse_face_overwritten_p - |= expose_window (XWINDOW (FVAR (f, tool_bar_window)), &r); + |= expose_window (XWINDOW (f->tool_bar_window), &r); #ifdef HAVE_X_WINDOWS #ifndef MSDOS #ifndef USE_X_TOOLKIT - if (WINDOWP (FVAR (f, menu_bar_window))) + if (WINDOWP (f->menu_bar_window)) mouse_face_overwritten_p - |= expose_window (XWINDOW (FVAR (f, menu_bar_window)), &r); + |= expose_window (XWINDOW (f->menu_bar_window), &r); #endif /* not USE_X_TOOLKIT */ #endif #endif @@ -29535,7 +29532,7 @@ init_xdisp (void) if (!noninteractive) { struct window *m = XWINDOW (minibuf_window); - Lisp_Object frame = WVAR (m, frame); + Lisp_Object frame = m->frame; struct frame *f = XFRAME (frame); Lisp_Object root = FRAME_ROOT_WINDOW (f); struct window *r = XWINDOW (root); @@ -29543,12 +29540,12 @@ init_xdisp (void) echo_area_window = minibuf_window; - XSETFASTINT (WVAR (r, top_line), FRAME_TOP_MARGIN (f)); - XSETFASTINT (WVAR (r, total_lines), FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f)); - XSETFASTINT (WVAR (r, total_cols), FRAME_COLS (f)); - XSETFASTINT (WVAR (m, top_line), FRAME_LINES (f) - 1); - XSETFASTINT (WVAR (m, total_lines), 1); - XSETFASTINT (WVAR (m, total_cols), FRAME_COLS (f)); + WSET (r, top_line, make_number (FRAME_TOP_MARGIN (f))); + WSET (r, total_lines, make_number (FRAME_LINES (f) - 1 - FRAME_TOP_MARGIN (f))); + WSET (r, total_cols, make_number (FRAME_COLS (f))); + WSET (m, top_line, make_number (FRAME_LINES (f) - 1)); + WSET (m, total_lines, make_number (1)); + WSET (m, total_cols, make_number (FRAME_COLS (f))); scratch_glyph_row.glyphs[TEXT_AREA] = scratch_glyphs; scratch_glyph_row.glyphs[TEXT_AREA + 1] diff --git a/src/xfaces.c b/src/xfaces.c index b92e0c82173..ed372c6b419 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -319,9 +319,9 @@ static Lisp_Object QCfontset; Lisp_Object Qnormal; Lisp_Object Qbold; static Lisp_Object Qline, Qwave; -static Lisp_Object Qultra_light, Qextra_light, Qlight; -static Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold; -static Lisp_Object Qoblique, Qreverse_oblique, Qreverse_italic; +Lisp_Object Qultra_light, Qextra_light, Qlight; +Lisp_Object Qsemi_light, Qsemi_bold, Qextra_bold, Qultra_bold; +Lisp_Object Qoblique, Qreverse_oblique, Qreverse_italic; Lisp_Object Qitalic; static Lisp_Object Qultra_condensed, Qextra_condensed; Lisp_Object Qcondensed; @@ -1559,8 +1559,10 @@ static enum font_property_index font_props_for_sorting[FONT_SIZE_INDEX]; static int compare_fonts_by_sort_order (const void *v1, const void *v2) { - Lisp_Object font1 = *(Lisp_Object *) v1; - Lisp_Object font2 = *(Lisp_Object *) v2; + Lisp_Object const *p1 = v1; + Lisp_Object const *p2 = v2; + Lisp_Object font1 = *p1; + Lisp_Object font2 = *p2; int i; for (i = 0; i < FONT_SIZE_INDEX; i++) @@ -1655,7 +1657,7 @@ the face font sort order. */) vec = Fvconcat (ndrivers, drivers); nfonts = ASIZE (vec); - qsort (XVECTOR (vec)->contents, nfonts, sizeof (Lisp_Object), + qsort (XVECTOR (vec)->contents, nfonts, word_size, compare_fonts_by_sort_order); result = Qnil; @@ -2051,7 +2053,7 @@ lface_from_face_name_no_resolve (struct frame *f, Lisp_Object face_name, Lisp_Object lface; if (f) - lface = assq_no_quit (face_name, FVAR (f, face_alist)); + lface = assq_no_quit (face_name, f->face_alist); else lface = assq_no_quit (face_name, Vface_new_frame_defaults); @@ -2182,14 +2184,14 @@ set_lface_from_font (struct frame *f, Lisp_Object lface, { Lisp_Object family = AREF (font_object, FONT_FAMILY_INDEX); - LFACE_FAMILY (lface) = SYMBOL_NAME (family); + ASET (lface, LFACE_FAMILY_INDEX, SYMBOL_NAME (family)); } if (force_p || UNSPECIFIEDP (LFACE_FOUNDRY (lface))) { Lisp_Object foundry = AREF (font_object, FONT_FOUNDRY_INDEX); - LFACE_FOUNDRY (lface) = SYMBOL_NAME (foundry); + ASET (lface, LFACE_FOUNDRY_INDEX, SYMBOL_NAME (foundry)); } if (force_p || UNSPECIFIEDP (LFACE_HEIGHT (lface))) @@ -2197,26 +2199,26 @@ set_lface_from_font (struct frame *f, Lisp_Object lface, int pt = PIXEL_TO_POINT (font->pixel_size * 10, f->resy); eassert (pt > 0); - LFACE_HEIGHT (lface) = make_number (pt); + ASET (lface, LFACE_HEIGHT_INDEX, make_number (pt)); } if (force_p || UNSPECIFIEDP (LFACE_WEIGHT (lface))) { val = FONT_WEIGHT_FOR_FACE (font_object); - LFACE_WEIGHT (lface) = ! NILP (val) ? val :Qnormal; + ASET (lface, LFACE_WEIGHT_INDEX, ! NILP (val) ? val :Qnormal); } if (force_p || UNSPECIFIEDP (LFACE_SLANT (lface))) { val = FONT_SLANT_FOR_FACE (font_object); - LFACE_SLANT (lface) = ! NILP (val) ? val : Qnormal; + ASET (lface, LFACE_SLANT_INDEX, ! NILP (val) ? val : Qnormal); } if (force_p || UNSPECIFIEDP (LFACE_SWIDTH (lface))) { val = FONT_WIDTH_FOR_FACE (font_object); - LFACE_SWIDTH (lface) = ! NILP (val) ? val : Qnormal; + ASET (lface, LFACE_SWIDTH_INDEX, ! NILP (val) ? val : Qnormal); } - LFACE_FONT (lface) = font_object; + ASET (lface, LFACE_FONT_INDEX, font_object); return 1; } @@ -2678,8 +2680,7 @@ Value is a vector of face attributes. */) lface = Fmake_vector (make_number (LFACE_VECTOR_SIZE), Qunspecified); ASET (lface, 0, Qface); - FVAR (f, face_alist) = Fcons (Fcons (face, lface), FVAR (f, - face_alist)); + FSET (f, face_alist, Fcons (Fcons (face, lface), f->face_alist)); } else for (i = 1; i < LFACE_VECTOR_SIZE; ++i) @@ -2766,7 +2767,7 @@ The value is TO. */) } memcpy (XVECTOR (copy)->contents, XVECTOR (lface)->contents, - LFACE_VECTOR_SIZE * sizeof (Lisp_Object)); + LFACE_VECTOR_SIZE * word_size); /* Changing a named face means that all realized faces depending on that face are invalid. Since we cannot tell which realized faces @@ -2851,7 +2852,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face family", value); } old_value = LFACE_FAMILY (lface); - LFACE_FAMILY (lface) = value; + ASET (lface, LFACE_FAMILY_INDEX, value); prop_index = FONT_FAMILY_INDEX; } else if (EQ (attr, QCfoundry)) @@ -2863,7 +2864,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face foundry", value); } old_value = LFACE_FOUNDRY (lface); - LFACE_FOUNDRY (lface) = value; + ASET (lface, LFACE_FOUNDRY_INDEX, value); prop_index = FONT_FOUNDRY_INDEX; } else if (EQ (attr, QCheight)) @@ -2891,7 +2892,7 @@ FRAME 0 means change the face on all frames, and change the default } old_value = LFACE_HEIGHT (lface); - LFACE_HEIGHT (lface) = value; + ASET (lface, LFACE_HEIGHT_INDEX, value); prop_index = FONT_SIZE_INDEX; } else if (EQ (attr, QCweight)) @@ -2903,7 +2904,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face weight", value); } old_value = LFACE_WEIGHT (lface); - LFACE_WEIGHT (lface) = value; + ASET (lface, LFACE_WEIGHT_INDEX, value); prop_index = FONT_WEIGHT_INDEX; } else if (EQ (attr, QCslant)) @@ -2915,7 +2916,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face slant", value); } old_value = LFACE_SLANT (lface); - LFACE_SLANT (lface) = value; + ASET (lface, LFACE_SLANT_INDEX, value); prop_index = FONT_SLANT_INDEX; } else if (EQ (attr, QCunderline)) @@ -2969,7 +2970,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face underline", value); old_value = LFACE_UNDERLINE (lface); - LFACE_UNDERLINE (lface) = value; + ASET (lface, LFACE_UNDERLINE_INDEX, value); } else if (EQ (attr, QCoverline)) { @@ -2983,7 +2984,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face overline", value); old_value = LFACE_OVERLINE (lface); - LFACE_OVERLINE (lface) = value; + ASET (lface, LFACE_OVERLINE_INDEX, value); } else if (EQ (attr, QCstrike_through)) { @@ -2997,7 +2998,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face strike-through", value); old_value = LFACE_STRIKE_THROUGH (lface); - LFACE_STRIKE_THROUGH (lface) = value; + ASET (lface, LFACE_STRIKE_THROUGH_INDEX, value); } else if (EQ (attr, QCbox)) { @@ -3060,7 +3061,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face box", value); old_value = LFACE_BOX (lface); - LFACE_BOX (lface) = value; + ASET (lface, LFACE_BOX_INDEX, value); } else if (EQ (attr, QCinverse_video) || EQ (attr, QCreverse_video)) @@ -3072,7 +3073,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid inverse-video face attribute value", value); } old_value = LFACE_INVERSE (lface); - LFACE_INVERSE (lface) = value; + ASET (lface, LFACE_INVERSE_INDEX, value); } else if (EQ (attr, QCforeground)) { @@ -3089,7 +3090,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Empty foreground color value", value); } old_value = LFACE_FOREGROUND (lface); - LFACE_FOREGROUND (lface) = value; + ASET (lface, LFACE_FOREGROUND_INDEX, value); } else if (EQ (attr, QCbackground)) { @@ -3106,7 +3107,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Empty background color value", value); } old_value = LFACE_BACKGROUND (lface); - LFACE_BACKGROUND (lface) = value; + ASET (lface, LFACE_BACKGROUND_INDEX, value); } else if (EQ (attr, QCstipple)) { @@ -3116,7 +3117,7 @@ FRAME 0 means change the face on all frames, and change the default && NILP (Fbitmap_spec_p (value))) signal_error ("Invalid stipple attribute", value); old_value = LFACE_STIPPLE (lface); - LFACE_STIPPLE (lface) = value; + ASET (lface, LFACE_STIPPLE_INDEX, value); #endif /* HAVE_X_WINDOWS || HAVE_NS */ } else if (EQ (attr, QCwidth)) @@ -3128,7 +3129,7 @@ FRAME 0 means change the face on all frames, and change the default signal_error ("Invalid face width", value); } old_value = LFACE_SWIDTH (lface); - LFACE_SWIDTH (lface) = value; + ASET (lface, LFACE_SWIDTH_INDEX, value); prop_index = FONT_WIDTH_INDEX; } else if (EQ (attr, QCfont)) @@ -3174,7 +3175,7 @@ FRAME 0 means change the face on all frames, and change the default set_lface_from_font (f, lface, value, 1); } else - LFACE_FONT (lface) = value; + ASET (lface, LFACE_FONT_INDEX, value); } #endif /* HAVE_WINDOW_SYSTEM */ } @@ -3189,7 +3190,7 @@ FRAME 0 means change the face on all frames, and change the default tmp = Fquery_fontset (value, Qnil); if (NILP (tmp)) signal_error ("Invalid fontset name", value); - LFACE_FONTSET (lface) = value = tmp; + ASET (lface, LFACE_FONTSET_INDEX, value = tmp); } #endif /* HAVE_WINDOW_SYSTEM */ } @@ -3203,21 +3204,21 @@ FRAME 0 means change the face on all frames, and change the default if (!SYMBOLP (XCAR (tail))) break; if (NILP (tail)) - LFACE_INHERIT (lface) = value; + ASET (lface, LFACE_INHERIT_INDEX, value); else signal_error ("Invalid face inheritance", value); } else if (EQ (attr, QCbold)) { old_value = LFACE_WEIGHT (lface); - LFACE_WEIGHT (lface) = NILP (value) ? Qnormal : Qbold; + ASET (lface, LFACE_WEIGHT_INDEX, NILP (value) ? Qnormal : Qbold); prop_index = FONT_WEIGHT_INDEX; } else if (EQ (attr, QCitalic)) { attr = QCslant; old_value = LFACE_SLANT (lface); - LFACE_SLANT (lface) = NILP (value) ? Qnormal : Qitalic; + ASET (lface, LFACE_SLANT_INDEX, NILP (value) ? Qnormal : Qitalic); prop_index = FONT_SLANT_INDEX; } else @@ -3358,15 +3359,15 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, /* If there are no faces yet, give up. This is the case when called from Fx_create_frame, and we do the necessary things later in face-set-after-frame-defaults. */ - if (NILP (FVAR (f, face_alist))) + if (NILP (f->face_alist)) return; if (EQ (param, Qforeground_color)) { face = Qdefault; lface = lface_from_face_name (f, face, 1); - LFACE_FOREGROUND (lface) = (STRINGP (new_value) - ? new_value : Qunspecified); + ASET (lface, LFACE_FOREGROUND_INDEX, + (STRINGP (new_value) ? new_value : Qunspecified)); realize_basic_faces (f); } else if (EQ (param, Qbackground_color)) @@ -3381,8 +3382,8 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, face = Qdefault; lface = lface_from_face_name (f, face, 1); - LFACE_BACKGROUND (lface) = (STRINGP (new_value) - ? new_value : Qunspecified); + ASET (lface, LFACE_BACKGROUND_INDEX, + (STRINGP (new_value) ? new_value : Qunspecified)); realize_basic_faces (f); } #ifdef HAVE_WINDOW_SYSTEM @@ -3390,22 +3391,22 @@ update_face_from_frame_parameter (struct frame *f, Lisp_Object param, { face = Qborder; lface = lface_from_face_name (f, face, 1); - LFACE_BACKGROUND (lface) = (STRINGP (new_value) - ? new_value : Qunspecified); + ASET (lface, LFACE_BACKGROUND_INDEX, + (STRINGP (new_value) ? new_value : Qunspecified)); } else if (EQ (param, Qcursor_color)) { face = Qcursor; lface = lface_from_face_name (f, face, 1); - LFACE_BACKGROUND (lface) = (STRINGP (new_value) - ? new_value : Qunspecified); + ASET (lface, LFACE_BACKGROUND_INDEX, + (STRINGP (new_value) ? new_value : Qunspecified)); } else if (EQ (param, Qmouse_color)) { face = Qmouse; lface = lface_from_face_name (f, face, 1); - LFACE_BACKGROUND (lface) = (STRINGP (new_value) - ? new_value : Qunspecified); + ASET (lface, LFACE_BACKGROUND_INDEX, + (STRINGP (new_value) ? new_value : Qunspecified)); } #endif @@ -3445,7 +3446,7 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface) font = font_load_for_lface (f, XVECTOR (lface)->contents, font); if (NILP (font)) return; - LFACE_FONT (lface) = font; + ASET (lface, LFACE_FONT_INDEX, font); } f->default_face_done_p = 0; Fmodify_frame_parameters (frame, Fcons (Fcons (Qfont, font), Qnil)); @@ -4044,7 +4045,7 @@ For internal use only. */) (Lisp_Object frame) { struct frame *f = frame_or_selected_frame (frame, 0); - return FVAR (f, face_alist); + return f->face_alist; } @@ -4335,7 +4336,7 @@ free_realized_faces (struct face_cache *c) matrices as invalid because they will reference faces freed above. This function is also called when a frame is destroyed. In this case, the root window of F is nil. */ - if (WINDOWP (FVAR (f, root_window))) + if (WINDOWP (f->root_window)) { clear_current_matrices (f); ++windows_or_buffers_changed; @@ -5108,7 +5109,7 @@ face for italic. */) { frame = XCAR (fl_tail); if (!NILP (Fequal (Fcdr (Fassq (Qdisplay, - FVAR (XFRAME (frame), param_alist))), + XFRAME (frame)->param_alist)), display))) break; } @@ -5366,52 +5367,52 @@ realize_default_face (struct frame *f) XSETFONT (font_object, FRAME_FONT (f)); set_lface_from_font (f, lface, font_object, f->default_face_done_p); - LFACE_FONTSET (lface) = fontset_name (FRAME_FONTSET (f)); + ASET (lface, LFACE_FONTSET_INDEX, fontset_name (FRAME_FONTSET (f))); f->default_face_done_p = 1; } #endif /* HAVE_WINDOW_SYSTEM */ if (!FRAME_WINDOW_P (f)) { - LFACE_FAMILY (lface) = build_string ("default"); - LFACE_FOUNDRY (lface) = LFACE_FAMILY (lface); - LFACE_SWIDTH (lface) = Qnormal; - LFACE_HEIGHT (lface) = make_number (1); + ASET (lface, LFACE_FAMILY_INDEX, build_string ("default")); + ASET (lface, LFACE_FOUNDRY_INDEX, LFACE_FAMILY (lface)); + ASET (lface, LFACE_SWIDTH_INDEX, Qnormal); + ASET (lface, LFACE_HEIGHT_INDEX, make_number (1)); if (UNSPECIFIEDP (LFACE_WEIGHT (lface))) - LFACE_WEIGHT (lface) = Qnormal; + ASET (lface, LFACE_WEIGHT_INDEX, Qnormal); if (UNSPECIFIEDP (LFACE_SLANT (lface))) - LFACE_SLANT (lface) = Qnormal; + ASET (lface, LFACE_SLANT_INDEX, Qnormal); if (UNSPECIFIEDP (LFACE_FONTSET (lface))) - LFACE_FONTSET (lface) = Qnil; + ASET (lface, LFACE_FONTSET_INDEX, Qnil); } if (UNSPECIFIEDP (LFACE_UNDERLINE (lface))) - LFACE_UNDERLINE (lface) = Qnil; + ASET (lface, LFACE_UNDERLINE_INDEX, Qnil); if (UNSPECIFIEDP (LFACE_OVERLINE (lface))) - LFACE_OVERLINE (lface) = Qnil; + ASET (lface, LFACE_OVERLINE_INDEX, Qnil); if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface))) - LFACE_STRIKE_THROUGH (lface) = Qnil; + ASET (lface, LFACE_STRIKE_THROUGH_INDEX, Qnil); if (UNSPECIFIEDP (LFACE_BOX (lface))) - LFACE_BOX (lface) = Qnil; + ASET (lface, LFACE_BOX_INDEX, Qnil); if (UNSPECIFIEDP (LFACE_INVERSE (lface))) - LFACE_INVERSE (lface) = Qnil; + ASET (lface, LFACE_INVERSE_INDEX, Qnil); if (UNSPECIFIEDP (LFACE_FOREGROUND (lface))) { /* This function is called so early that colors are not yet set in the frame parameter list. */ - Lisp_Object color = Fassq (Qforeground_color, FVAR (f, param_alist)); + Lisp_Object color = Fassq (Qforeground_color, f->param_alist); if (CONSP (color) && STRINGP (XCDR (color))) - LFACE_FOREGROUND (lface) = XCDR (color); + ASET (lface, LFACE_FOREGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) return 0; else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - LFACE_FOREGROUND (lface) = build_string (unspecified_fg); + ASET (lface, LFACE_FOREGROUND_INDEX, build_string (unspecified_fg)); else abort (); } @@ -5420,19 +5421,19 @@ realize_default_face (struct frame *f) { /* This function is called so early that colors are not yet set in the frame parameter list. */ - Lisp_Object color = Fassq (Qbackground_color, FVAR (f, param_alist)); + Lisp_Object color = Fassq (Qbackground_color, f->param_alist); if (CONSP (color) && STRINGP (XCDR (color))) - LFACE_BACKGROUND (lface) = XCDR (color); + ASET (lface, LFACE_BACKGROUND_INDEX, XCDR (color)); else if (FRAME_WINDOW_P (f)) return 0; else if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f)) - LFACE_BACKGROUND (lface) = build_string (unspecified_bg); + ASET (lface, LFACE_BACKGROUND_INDEX, build_string (unspecified_bg)); else abort (); } if (UNSPECIFIEDP (LFACE_STIPPLE (lface))) - LFACE_STIPPLE (lface) = Qnil; + ASET (lface, LFACE_STIPPLE_INDEX, Qnil); /* Realize the face; it must be fully-specified now. */ eassert (lface_fully_specified_p (XVECTOR (lface)->contents)); @@ -6031,12 +6032,11 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, ptrdiff_t *endptr, ptrdiff_t limit, int mouse, int base_face_id) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object prop, position; ptrdiff_t i, noverlays; Lisp_Object *overlay_vec; - Lisp_Object frame; ptrdiff_t endpos; Lisp_Object propname = mouse ? Qmouse_face : Qface; Lisp_Object limit1, end; @@ -6046,7 +6046,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, to use the frame and buffer of W, but right now it doesn't. */ /* eassert (XBUFFER (w->buffer) == current_buffer); */ - XSETFRAME (frame, f); XSETFASTINT (position, pos); endpos = ZV; @@ -6055,9 +6054,9 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, /* Get the `face' or `mouse_face' text property at POS, and determine the next position at which the property changes. */ - prop = Fget_text_property (position, propname, WVAR (w, buffer)); + prop = Fget_text_property (position, propname, w->buffer); XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); - end = Fnext_single_property_change (position, propname, WVAR (w, buffer), limit1); + end = Fnext_single_property_change (position, propname, w->buffer, limit1); if (INTEGERP (end)) endpos = XINT (end); @@ -6103,7 +6102,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos, for (i = 0; i < noverlays; i++) { Lisp_Object oend; - int oendpos; + ptrdiff_t oendpos; prop = Foverlay_get (overlay_vec[i], propname); if (!NILP (prop)) @@ -6143,11 +6142,10 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, ptrdiff_t *endptr, ptrdiff_t limit, int mouse, Lisp_Object overlay) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); Lisp_Object attrs[LFACE_VECTOR_SIZE]; Lisp_Object prop, position; - Lisp_Object frame; - int endpos; + ptrdiff_t endpos; Lisp_Object propname = mouse ? Qmouse_face : Qface; Lisp_Object limit1, end; struct face *default_face; @@ -6156,7 +6154,6 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, to use the frame and buffer of W, but right now it doesn't. */ /* eassert (XBUFFER (w->buffer) == current_buffer); */ - XSETFRAME (frame, f); XSETFASTINT (position, pos); endpos = ZV; @@ -6165,9 +6162,9 @@ face_for_overlay_string (struct window *w, ptrdiff_t pos, /* Get the `face' or `mouse_face' text property at POS, and determine the next position at which the property changes. */ - prop = Fget_text_property (position, propname, WVAR (w, buffer)); + prop = Fget_text_property (position, propname, w->buffer); XSETFASTINT (limit1, (limit < endpos ? limit : endpos)); - end = Fnext_single_property_change (position, propname, WVAR (w, buffer), limit1); + end = Fnext_single_property_change (position, propname, w->buffer, limit1); if (INTEGERP (end)) endpos = XINT (end); diff --git a/src/xfns.c b/src/xfns.c index df66cbe1ab4..2e7334b7d71 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -21,7 +21,6 @@ along with GNU Emacs. If not, see . */ #include #include #include -#include #include /* This makes the fields of a Display accessible, in Xlib header files. */ @@ -130,7 +129,6 @@ extern LWLIB_ID widget_id_tick; int x_in_use; -static Lisp_Object Qnone; static Lisp_Object Qsuppress_icon; static Lisp_Object Qundefined_color; static Lisp_Object Qcompound_text, Qcancel_timer; @@ -141,10 +139,6 @@ static ptrdiff_t image_cache_refcount; static int dpyinfo_refcount; #endif -#if defined (USE_GTK) && defined (HAVE_FREETYPE) -static char *x_last_font_name; -#endif - static struct x_display_info *x_display_info_for_name (Lisp_Object); @@ -460,7 +454,7 @@ x_real_positions (FRAME_PTR f, int *xptr, int *yptr) if (! success) break; - XFree ((char *) tmp_children); + XFree (tmp_children); if (wm_window == rootw || had_errors) break; @@ -665,7 +659,7 @@ x_set_tool_bar_position (struct frame *f, #ifdef USE_GTK if (xg_change_toolbar_position (f, new_value)) - FVAR (f, tool_bar_position) = new_value; + FSET (f, tool_bar_position, new_value); #endif } @@ -1123,9 +1117,9 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) BLOCK_INPUT; if (NILP (arg)) result = x_text_icon (f, - SSDATA ((!NILP (FVAR (f, icon_name)) - ? FVAR (f, icon_name) - : FVAR (f, name)))); + SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : f->name))); else result = x_bitmap_icon (f, arg); @@ -1152,7 +1146,7 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) else if (!NILP (arg) || NILP (oldval)) return; - FVAR (f, icon_name) = arg; + FSET (f, icon_name, arg); if (f->output_data.x->icon_bitmap != 0) return; @@ -1160,11 +1154,11 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) BLOCK_INPUT; result = x_text_icon (f, - SSDATA ((!NILP (FVAR (f, icon_name)) - ? FVAR (f, icon_name) - : !NILP (FVAR (f, title)) - ? FVAR (f, title) - : FVAR (f, name)))); + SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : !NILP (f->title) + ? f->title + : f->name))); if (result) { @@ -1352,8 +1346,8 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) UNBLOCK_INPUT; } - if (WINDOWP (FVAR (f, tool_bar_window))) - clear_glyph_matrix (XWINDOW (FVAR (f, tool_bar_window))->current_matrix); + if (WINDOWP (f->tool_bar_window)) + clear_glyph_matrix (XWINDOW (f->tool_bar_window)->current_matrix); } run_window_configuration_change_hook (f); @@ -1548,7 +1542,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name) if (text.nitems != bytes) error ("Window name too large"); - if (!STRINGP (FVAR (f, icon_name))) + if (!STRINGP (f->icon_name)) { icon = text; encoded_icon_name = encoded_name; @@ -1556,7 +1550,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name) else { /* See the above comment "Note: Encoding strategy". */ - icon.value = x_encode_text (FVAR (f, icon_name), coding_system, 0, + icon.value = x_encode_text (f->icon_name, coding_system, 0, &bytes, &stringp, &do_free_icon_value); icon.encoding = (stringp ? XA_STRING : FRAME_X_DISPLAY_INFO (f)->Xatom_COMPOUND_TEXT); @@ -1565,7 +1559,7 @@ x_set_name_internal (FRAME_PTR f, Lisp_Object name) if (icon.nitems != bytes) error ("Icon name too large"); - encoded_icon_name = ENCODE_UTF_8 (FVAR (f, icon_name)); + encoded_icon_name = ENCODE_UTF_8 (f->icon_name); } #ifdef USE_GTK @@ -1632,7 +1626,7 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit) /* Check for no change needed in this very common case before we do any consing. */ if (!strcmp (FRAME_X_DISPLAY_INFO (f)->x_id_name, - SSDATA (FVAR (f, name)))) + SSDATA (f->name))) return; name = build_string (FRAME_X_DISPLAY_INFO (f)->x_id_name); } @@ -1640,15 +1634,15 @@ x_set_name (struct frame *f, Lisp_Object name, int explicit) CHECK_STRING (name); /* Don't change the name if it's already NAME. */ - if (! NILP (Fstring_equal (name, FVAR (f, name)))) + if (! NILP (Fstring_equal (name, f->name))) return; - FVAR (f, name) = name; + FSET (f, name, name); /* For setting the frame title, the title parameter should override the name parameter. */ - if (! NILP (FVAR (f, title))) - name = FVAR (f, title); + if (! NILP (f->title)) + name = f->title; x_set_name_internal (f, name); } @@ -1678,15 +1672,15 @@ static void x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) { /* Don't change the title if it's already NAME. */ - if (EQ (name, FVAR (f, title))) + if (EQ (name, f->title)) return; update_mode_lines = 1; - FVAR (f, title) = name; + FSET (f, title, name); if (NILP (name)) - name = FVAR (f, name); + name = f->name; else CHECK_STRING (name); @@ -2260,7 +2254,7 @@ free_frame_xic (struct frame *f) void xic_set_preeditarea (struct window *w, int x, int y) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); XVaNestedList attr; XPoint spot; @@ -2571,8 +2565,8 @@ x_window (struct frame *f, long window_prompting, int minibuffer_only) int explicit = f->explicit_name; f->explicit_name = 0; - name = FVAR (f, name); - FVAR (f, name) = Qnil; + name = f->name; + FSET (f, name, Qnil); x_set_name (f, name, explicit); } @@ -2714,8 +2708,8 @@ x_window (struct frame *f) int explicit = f->explicit_name; f->explicit_name = 0; - name = FVAR (f, name); - FVAR (f, name) = Qnil; + name = f->name; + FSET (f, name, Qnil); x_set_name (f, name, explicit); } @@ -2791,9 +2785,9 @@ x_icon (struct frame *f, Lisp_Object parms) : NormalState)); #endif - x_text_icon (f, SSDATA ((!NILP (FVAR (f, icon_name)) - ? FVAR (f, icon_name) - : FVAR (f, name)))); + x_text_icon (f, SSDATA ((!NILP (f->icon_name) + ? f->icon_name + : f->name))); UNBLOCK_INPUT; } @@ -3135,11 +3129,11 @@ This function is an internal primitive--use `make-frame' instead. */) f->output_data.x->scroll_bar_bottom_shadow_pixel = -1; #endif /* USE_TOOLKIT_SCROLL_BARS */ - FVAR (f, icon_name) - = x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", - RES_TYPE_STRING); - if (! STRINGP (FVAR (f, icon_name))) - FVAR (f, icon_name) = Qnil; + FSET (f, icon_name, + x_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", + RES_TYPE_STRING)); + if (! STRINGP (f->icon_name)) + FSET (f, icon_name, Qnil); FRAME_X_DISPLAY_INFO (f) = dpyinfo; @@ -3196,12 +3190,12 @@ This function is an internal primitive--use `make-frame' instead. */) be set. */ if (EQ (name, Qunbound) || NILP (name)) { - FVAR (f, name) = build_string (dpyinfo->x_id_name); + FSET (f, name, build_string (dpyinfo->x_id_name)); f->explicit_name = 0; } else { - FVAR (f, name) = name; + FSET (f, name, name); f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); @@ -3340,7 +3334,7 @@ This function is an internal primitive--use `make-frame' instead. */) x_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); x_default_parameter (f, parms, Qtool_bar_position, - FVAR (f, tool_bar_position), 0, 0, RES_TYPE_SYMBOL); + f->tool_bar_position, 0, 0, RES_TYPE_SYMBOL); /* Compute the size of the X window. */ window_prompting = x_figure_window_size (f, parms, 1); @@ -3462,13 +3456,13 @@ This function is an internal primitive--use `make-frame' instead. */) if (FRAME_HAS_MINIBUF_P (f) && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) - KVAR (kb, Vdefault_minibuffer_frame) = frame; + KSET (kb, Vdefault_minibuffer_frame, frame); /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ for (tem = parms; CONSP (tem); tem = XCDR (tem)) if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) - FVAR (f, param_alist) = Fcons (XCAR (tem), FVAR (f, param_alist)); + FSET (f, param_alist, Fcons (XCAR (tem), f->param_alist)); UNGCPRO; @@ -4001,7 +3995,7 @@ select_visual (struct x_display_info *dpyinfo) fatal ("Can't get proper X visual info"); dpyinfo->n_planes = vinfo->depth; - XFree ((char *) vinfo); + XFree (vinfo); } } @@ -4592,10 +4586,12 @@ x_create_tip_frame (struct x_display_info *dpyinfo, XSETFRAME (frame, f); buffer = Fget_buffer_create (build_string (" *tip*")); - Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); + /* Use set_window_buffer instead of Fset_window_buffer (see + discussion of bug#11984, bug#12025, bug#12026). */ + set_window_buffer (FRAME_ROOT_WINDOW (f), buffer, 0, 0); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - BVAR (current_buffer, truncate_lines) = Qnil; + BSET (current_buffer, truncate_lines, Qnil); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -4621,7 +4617,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, f->output_data.x->scroll_bar_top_shadow_pixel = -1; f->output_data.x->scroll_bar_bottom_shadow_pixel = -1; #endif /* USE_TOOLKIT_SCROLL_BARS */ - FVAR (f, icon_name) = Qnil; + FSET (f, icon_name, Qnil); FRAME_X_DISPLAY_INFO (f) = dpyinfo; f->output_data.x->parent_desc = FRAME_X_DISPLAY_INFO (f)->root_window; f->output_data.x->explicit_parent = 0; @@ -4663,12 +4659,12 @@ x_create_tip_frame (struct x_display_info *dpyinfo, be set. */ if (EQ (name, Qunbound) || NILP (name)) { - FVAR (f, name) = build_string (dpyinfo->x_id_name); + FSET (f, name, build_string (dpyinfo->x_id_name)); f->explicit_name = 0; } else { - FVAR (f, name) = name; + FSET (f, name, name); f->explicit_name = 1; /* use the frame's title when getting resources for this frame. */ specbind (Qx_resource_name, name); @@ -5069,29 +5065,30 @@ Text larger than the specified size is clipped. */) /* Set up the frame's root window. */ w = XWINDOW (FRAME_ROOT_WINDOW (f)); - WVAR (w, left_col) = WVAR (w, top_line) = make_number (0); + WSET (w, left_col, make_number (0)); + WSET (w, top_line, make_number (0)); if (CONSP (Vx_max_tooltip_size) && RANGED_INTEGERP (1, XCAR (Vx_max_tooltip_size), INT_MAX) && RANGED_INTEGERP (1, XCDR (Vx_max_tooltip_size), INT_MAX)) { - WVAR (w, total_cols) = XCAR (Vx_max_tooltip_size); - WVAR (w, total_lines) = XCDR (Vx_max_tooltip_size); + WSET (w, total_cols, XCAR (Vx_max_tooltip_size)); + WSET (w, total_lines, XCDR (Vx_max_tooltip_size)); } else { - WVAR (w, total_cols) = make_number (80); - WVAR (w, total_lines) = make_number (40); + WSET (w, total_cols, make_number (80)); + WSET (w, total_lines, make_number (40)); } - FRAME_TOTAL_COLS (f) = XINT (WVAR (w, total_cols)); + FRAME_TOTAL_COLS (f) = XINT (w->total_cols); adjust_glyphs (f); w->pseudo_window_p = 1; /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; - set_buffer_internal_1 (XBUFFER (WVAR (XWINDOW (FRAME_ROOT_WINDOW (f)), buffer))); - BVAR (current_buffer, truncate_lines) = Qnil; + set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); + BSET (current_buffer, truncate_lines, Qnil); clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); @@ -5151,7 +5148,7 @@ Text larger than the specified size is clipped. */) /* w->total_cols and FRAME_TOTAL_COLS want the width in columns, not in pixels. */ width /= WINDOW_FRAME_COLUMN_WIDTH (w); - WVAR (w, total_cols) = make_number (width); + WSET (w, total_cols, make_number (width)); FRAME_TOTAL_COLS (f) = width; adjust_glyphs (f); clear_glyph_matrix (w->desired_matrix); @@ -5581,14 +5578,15 @@ Otherwise, if ONLY-DIR-P is non-nil, the user can only select directories. */) #ifdef HAVE_FREETYPE DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, - doc: /* Read a font name using a GTK font selection dialog. -Return a GTK-style font string corresponding to the selection. + doc: /* Read a font using a GTK dialog. +Return either a font spec (for GTK versions >= 3.2) or a string +containing a GTK-style font name. -If FRAME is omitted or nil, it defaults to the selected frame. */) +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. */) (Lisp_Object frame, Lisp_Object ignored) { FRAME_PTR f = check_x_frame (frame); - char *name; Lisp_Object font; Lisp_Object font_param; char *default_name = NULL; @@ -5619,32 +5617,9 @@ If FRAME is omitted or nil, it defaults to the selected frame. */) default_name = xstrdup (SSDATA (font_param)); } - if (default_name == NULL && x_last_font_name != NULL) - default_name = xstrdup (x_last_font_name); - - /* Convert fontconfig names to Gtk names, i.e. remove - before number */ - if (default_name) - { - char *p = strrchr (default_name, '-'); - if (p) - { - char *ep = p+1; - while (isdigit (*ep)) - ++ep; - if (*ep == '\0') *p = ' '; - } - } - - name = xg_get_font_name (f, default_name); + font = xg_get_font (f, default_name); xfree (default_name); - if (name) - { - font = build_string (name); - g_free (x_last_font_name); - x_last_font_name = name; - } - UNBLOCK_INPUT; if (NILP (font)) @@ -5813,7 +5788,6 @@ syms_of_xfns (void) /* The section below is built by the lisp expression at the top of the file, just above where these variables are declared. */ /*&&& init symbols here &&&*/ - DEFSYM (Qnone, "none"); DEFSYM (Qsuppress_icon, "suppress-icon"); DEFSYM (Qundefined_color, "undefined-color"); DEFSYM (Qcompound_text, "compound-text"); @@ -6010,7 +5984,6 @@ When using Gtk+ tooltips, the tooltip face is not used. */); #if defined (USE_GTK) && defined (HAVE_FREETYPE) defsubr (&Sx_select_font); - x_last_font_name = NULL; #endif } diff --git a/src/xfont.c b/src/xfont.c index 0443b49de8f..9e929eed678 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -59,7 +59,7 @@ xfont_get_pcm (XFontStruct *xfont, XChar2b *char2b) /* The result metric information. */ XCharStruct *pcm = NULL; - font_assert (xfont && char2b); + eassert (xfont && char2b); if (xfont->per_char != NULL) { @@ -463,12 +463,12 @@ xfont_list_pattern (Display *display, const char *pattern, list = Fcons (entity, list); continue; } - if (memcmp (props, &(AREF (entity, FONT_FOUNDRY_INDEX)), - sizeof (Lisp_Object) * 7) + if (memcmp (props, aref_addr (entity, FONT_FOUNDRY_INDEX), + word_size * 7) || ! EQ (AREF (entity, FONT_SPACING_INDEX), props[7])) { - memcpy (props, &(AREF (entity, FONT_FOUNDRY_INDEX)), - sizeof (Lisp_Object) * 7); + memcpy (props, aref_addr (entity, FONT_FOUNDRY_INDEX), + word_size * 7); props[7] = AREF (entity, FONT_SPACING_INDEX); scripts = xfont_supported_scripts (display, indices[i], xfont_scratch_props, encoding); @@ -1035,10 +1035,8 @@ xfont_draw (struct glyph_string *s, int from, int to, int x, int y, int with_bac if (xfont->min_byte1 == 0 && xfont->max_byte1 == 0) { - char *str; USE_SAFE_ALLOCA; - - SAFE_ALLOCA (str, char *, len); + char *str = SAFE_ALLOCA (len); for (i = 0; i < len ; i++) str[i] = XCHAR2B_BYTE2 (s->char2b + from + i); BLOCK_INPUT; diff --git a/src/xftfont.c b/src/xftfont.c index f999ac662ce..2f8125393bc 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -622,8 +622,7 @@ xftfont_get_xft_draw (FRAME_PTR f) FRAME_X_VISUAL (f), FRAME_X_COLORMAP (f)); UNBLOCK_INPUT; - if (! xft_draw) - abort (); + eassert (xft_draw != NULL); font_put_frame_data (f, &xftfont_driver, xft_draw); } return xft_draw; diff --git a/src/xmenu.c b/src/xmenu.c index e68245ba379..ab790094f85 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -835,7 +835,7 @@ menubar_selection_callback (Widget widget, LWLIB_ID id, XtPointer client_data) if (!f) return; find_and_call_menu_selection (f, f->menu_bar_items_used, - FVAR (f, menu_bar_vector), client_data); + f->menu_bar_vector, client_data); } #endif /* not USE_GTK */ @@ -985,7 +985,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) if (! menubar_widget) previous_menu_items_used = 0; - buffer = WVAR (XWINDOW (FRAME_SELECTED_WINDOW (f)), buffer); + buffer = XWINDOW (FRAME_SELECTED_WINDOW (f))->buffer; specbind (Qinhibit_quit, Qt); /* Don't let the debugger step into this code because it is not reentrant. */ @@ -1008,20 +1008,20 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) if (! NILP (Vlucid_menu_bar_dirty_flag)) call0 (Qrecompute_lucid_menubar); safe_run_hooks (Qmenu_bar_update_hook); - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); items = FRAME_MENU_BAR_ITEMS (f); /* Save the frame's previous menu bar contents data. */ if (previous_menu_items_used) - memcpy (previous_items, XVECTOR (FVAR (f, menu_bar_vector))->contents, - previous_menu_items_used * sizeof (Lisp_Object)); + memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents, + previous_menu_items_used * word_size); /* Fill in menu_items with the current menu bar contents. This can evaluate Lisp code. */ save_menu_items (); - menu_items = FVAR (f, menu_bar_vector); + menu_items = f->menu_bar_vector; menu_items_allocated = VECTORP (menu_items) ? ASIZE (menu_items) : 0; subitems = ASIZE (items) / 4; submenu_start = alloca ((subitems + 1) * sizeof *submenu_start); @@ -1100,7 +1100,7 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) } /* The menu items are different, so store them in the frame. */ - FVAR (f, menu_bar_vector) = menu_items; + FSET (f, menu_bar_vector, menu_items); f->menu_bar_items_used = menu_items_used; /* This undoes save_menu_items. */ @@ -1283,7 +1283,7 @@ initialize_frame_menubar (FRAME_PTR f) { /* This function is called before the first chance to redisplay the frame. It has to be, so the frame will have the right size. */ - FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); + FSET (f, menu_bar_items, menu_bar_items (FRAME_MENU_BAR_ITEMS (f))); set_frame_menubar (f, 1, 1); } @@ -1782,8 +1782,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, /* If this item has a null value, make the call_data null so that it won't display a box when the mouse is on it. */ - wv->call_data - = (!NILP (def) ? (void *) &AREF (menu_items, i) : 0); + wv->call_data = !NILP (def) ? aref_addr (menu_items, i) : 0; wv->enabled = !NILP (enable); if (NILP (type)) @@ -1884,7 +1883,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, { entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); - if (menu_item_selection == &AREF (menu_items, i)) + if (menu_item_selection == aref_addr (menu_items, i)) { if (keymaps != 0) { @@ -2104,7 +2103,7 @@ xdialog_show (FRAME_PTR f, if (!NILP (descrip)) wv->key = SSDATA (descrip); wv->value = SSDATA (item_name); - wv->call_data = (void *) &AREF (menu_items, i); + wv->call_data = aref_addr (menu_items, i); wv->enabled = !NILP (enable); wv->help = Qnil; prev_wv = wv; @@ -2187,7 +2186,7 @@ xdialog_show (FRAME_PTR f, { entry = AREF (menu_items, i + MENU_ITEMS_ITEM_VALUE); - if (menu_item_selection == &AREF (menu_items, i)) + if (menu_item_selection == aref_addr (menu_items, i)) { if (keymaps != 0) { @@ -2576,7 +2575,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, /* Detect if a dialog or menu has been posted. MSDOS has its own implementation on msdos.c. */ -int +int ATTRIBUTE_CONST popup_activated (void) { return popup_activated_flag; diff --git a/src/xselect.c b/src/xselect.c index e2da561e953..664b5f92a15 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -216,7 +216,7 @@ x_stop_queuing_selection_requests (void) TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp); kbd_buffer_unget_event (&queue_tmp->event); selection_queue = queue_tmp->next; - xfree ((char *)queue_tmp); + xfree (queue_tmp); } } @@ -353,8 +353,8 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, INTEGER_TO_CONS (timestamp), frame); prev_value = LOCAL_SELECTION (selection_name, dpyinfo); - dpyinfo->terminal->Vselection_alist - = Fcons (selection_data, dpyinfo->terminal->Vselection_alist); + TSET (dpyinfo->terminal, Vselection_alist, + Fcons (selection_data, dpyinfo->terminal->Vselection_alist)); /* If we already owned the selection, remove the old selection data. Don't use Fdelq as that may QUIT. */ @@ -989,7 +989,7 @@ x_handle_selection_clear (struct input_event *event) break; } } - dpyinfo->terminal->Vselection_alist = Vselection_alist; + TSET (dpyinfo->terminal, Vselection_alist, Vselection_alist); /* Run the `x-lost-selection-functions' abnormal hook. */ { @@ -1039,7 +1039,7 @@ x_clear_frame_selections (FRAME_PTR f) args[1] = Fcar (Fcar (t->Vselection_alist)); Frun_hook_with_args (2, args); - t->Vselection_alist = XCDR (t->Vselection_alist); + TSET (t, Vselection_alist, XCDR (t->Vselection_alist)); } /* Delete elements after the beginning of Vselection_alist. */ @@ -1321,7 +1321,7 @@ x_get_window_property (Display *display, Window window, Atom property, goto done; /* This was allocated by Xlib, so use XFree. */ - XFree ((char *) tmp_data); + XFree (tmp_data); if (*actual_type_ret == None || *actual_format_ret == 0) goto done; @@ -1403,7 +1403,7 @@ x_get_window_property (Display *display, Window window, Atom property, offset += bytes_gotten; /* This was allocated by Xlib, so use XFree. */ - XFree ((char *) tmp_data); + XFree (tmp_data); } XFlush (display); @@ -1568,7 +1568,7 @@ x_get_window_property_as_lisp_data (Display *display, Window window, BLOCK_INPUT; /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ - xfree ((char *) data); + xfree (data); UNBLOCK_INPUT; receive_incremental_selection (display, window, property, target_type, min_size_bytes, &data, &bytes, @@ -1589,7 +1589,7 @@ x_get_window_property_as_lisp_data (Display *display, Window window, /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ - xfree ((char *) data); + xfree (data); return val; } diff --git a/src/xterm.c b/src/xterm.c index 4c260250e05..2e71ccd94a0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -523,7 +523,7 @@ x_set_frame_alpha (struct frame *f) if (rc == Success && actual != None) { unsigned long value = *(unsigned long *)data; - XFree ((void *) data); + XFree (data); if (value == opac) { x_uncatch_errors (); @@ -631,7 +631,7 @@ x_draw_vertical_window_border (struct window *w, int x, int y0, int y1) static void x_update_window_end (struct window *w, int cursor_on_p, int mouse_face_overwritten_p) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (WVAR (w, frame))); + Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (XFRAME (w->frame)); if (!w->pseudo_window_p) { @@ -731,7 +731,7 @@ x_after_update_window_line (struct glyph_row *desired_row) overhead is very small. */ if (windows_or_buffers_changed && desired_row->full_width_p - && (f = XFRAME (WVAR (w, frame)), + && (f = XFRAME (w->frame), width = FRAME_INTERNAL_BORDER_WIDTH (f), width != 0) && (height = desired_row->visible_height, @@ -3304,7 +3304,7 @@ x_ins_del_lines (struct frame *f, int vpos, int n) static void x_scroll_run (struct window *w, struct run *run) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); int x, y, width, height, from_y, to_y, bottom_y; /* Get frame-relative bounding box of the text display area of W, @@ -3594,7 +3594,7 @@ x_frame_rehighlight (struct x_display_info *dpyinfo) : dpyinfo->x_focus_frame); if (! FRAME_LIVE_P (dpyinfo->x_highlight_frame)) { - FRAME_FOCUS_FRAME (dpyinfo->x_focus_frame) = Qnil; + FSET (dpyinfo->x_focus_frame, focus_frame, Qnil); dpyinfo->x_highlight_frame = dpyinfo->x_focus_frame; } } @@ -3719,7 +3719,7 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) dpyinfo->alt_mod_mask &= ~dpyinfo->meta_mod_mask; } - XFree ((char *) syms); + XFree (syms); XFreeModifiermap (mods); } @@ -4253,9 +4253,9 @@ xt_action_hook (Widget widget, XtPointer client_data, String action_name, scroll_bar_end_scroll, 0, 0); w = XWINDOW (window_being_scrolled); - if (!NILP (XSCROLL_BAR (WVAR (w, vertical_scroll_bar))->dragging)) + if (!NILP (XSCROLL_BAR (w->vertical_scroll_bar)->dragging)) { - XSCROLL_BAR (WVAR (w, vertical_scroll_bar))->dragging = Qnil; + XSCROLL_BAR (w->vertical_scroll_bar)->dragging = Qnil; /* The thumb size is incorrect while dragging: fix it. */ set_vertical_scroll_bar (w); } @@ -4286,7 +4286,7 @@ x_send_scroll_bar_event (Lisp_Object window, int part, int portion, int whole) XEvent event; XClientMessageEvent *ev = (XClientMessageEvent *) &event; struct window *w = XWINDOW (window); - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); ptrdiff_t i; BLOCK_INPUT; @@ -4362,7 +4362,7 @@ x_scroll_bar_to_input_event (XEvent *event, struct input_event *ievent) ievent->timestamp = CurrentTime; #else ievent->timestamp = - XtLastTimestampProcessed (FRAME_X_DISPLAY (XFRAME (WVAR (w, frame)))); + XtLastTimestampProcessed (FRAME_X_DISPLAY (XFRAME (w->frame))); #endif ievent->part = ev->data.l[1]; ievent->code = ev->data.l[2]; @@ -4963,9 +4963,10 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio static struct scroll_bar * x_scroll_bar_create (struct window *w, int top, int left, int width, int height) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct scroll_bar *bar = ALLOCATE_PSEUDOVECTOR (struct scroll_bar, x_window, PVEC_OTHER); + Lisp_Object barobj; BLOCK_INPUT; @@ -5026,7 +5027,8 @@ x_scroll_bar_create (struct window *w, int top, int left, int width, int height) /* Add bar to its frame's list of scroll bars. */ bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; - XSETVECTOR (FRAME_SCROLL_BARS (f), bar); + XSETVECTOR (barobj, bar); + FSET (f, scroll_bars, barobj); if (!NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); @@ -5189,7 +5191,7 @@ x_scroll_bar_remove (struct scroll_bar *bar) #endif /* Dissociate this scroll bar from its window. */ - WVAR (XWINDOW (bar->window), vertical_scroll_bar) = Qnil; + WSET (XWINDOW (bar->window), vertical_scroll_bar, Qnil); UNBLOCK_INPUT; } @@ -5203,7 +5205,8 @@ x_scroll_bar_remove (struct scroll_bar *bar) static void XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int position) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); + Lisp_Object barobj; struct scroll_bar *bar; int top, height, left, sb_left, width, sb_width; int window_y, window_height; @@ -5254,7 +5257,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio #endif /* Does the scroll bar exist yet? */ - if (NILP (WVAR (w, vertical_scroll_bar))) + if (NILP (w->vertical_scroll_bar)) { if (width > 0 && height > 0) { @@ -5277,7 +5280,7 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio /* It may just need to be moved and resized. */ unsigned int mask = 0; - bar = XSCROLL_BAR (WVAR (w, vertical_scroll_bar)); + bar = XSCROLL_BAR (w->vertical_scroll_bar); BLOCK_INPUT; @@ -5401,7 +5404,8 @@ XTset_vertical_scroll_bar (struct window *w, int portion, int whole, int positio } #endif /* not USE_TOOLKIT_SCROLL_BARS */ - XSETVECTOR (WVAR (w, vertical_scroll_bar), bar); + XSETVECTOR (barobj, bar); + WSET (w, vertical_scroll_bar, barobj); } @@ -5425,12 +5429,12 @@ XTcondemn_scroll_bars (FRAME_PTR frame) { Lisp_Object bar; bar = FRAME_SCROLL_BARS (frame); - FRAME_SCROLL_BARS (frame) = XSCROLL_BAR (bar)->next; + FSET (frame, scroll_bars, XSCROLL_BAR (bar)->next); XSCROLL_BAR (bar)->next = FRAME_CONDEMNED_SCROLL_BARS (frame); XSCROLL_BAR (bar)->prev = Qnil; if (! NILP (FRAME_CONDEMNED_SCROLL_BARS (frame))) XSCROLL_BAR (FRAME_CONDEMNED_SCROLL_BARS (frame))->prev = bar; - FRAME_CONDEMNED_SCROLL_BARS (frame) = bar; + FSET (frame, condemned_scroll_bars, bar); } } @@ -5443,12 +5447,13 @@ XTredeem_scroll_bar (struct window *window) { struct scroll_bar *bar; struct frame *f; + Lisp_Object barobj; /* We can't redeem this window's scroll bar if it doesn't have one. */ - if (NILP (WVAR (window, vertical_scroll_bar))) + if (NILP (window->vertical_scroll_bar)) abort (); - bar = XSCROLL_BAR (WVAR (window, vertical_scroll_bar)); + bar = XSCROLL_BAR (window->vertical_scroll_bar); /* Unlink it from the condemned list. */ f = XFRAME (WINDOW_FRAME (window)); @@ -5456,12 +5461,12 @@ XTredeem_scroll_bar (struct window *window) { /* If the prev pointer is nil, it must be the first in one of the lists. */ - if (EQ (FRAME_SCROLL_BARS (f), WVAR (window, vertical_scroll_bar))) + if (EQ (FRAME_SCROLL_BARS (f), window->vertical_scroll_bar)) /* It's not condemned. Everything's fine. */ return; else if (EQ (FRAME_CONDEMNED_SCROLL_BARS (f), - WVAR (window, vertical_scroll_bar))) - FRAME_CONDEMNED_SCROLL_BARS (f) = bar->next; + window->vertical_scroll_bar)) + FSET (f, condemned_scroll_bars, bar->next); else /* If its prev pointer is nil, it must be at the front of one or the other! */ @@ -5475,7 +5480,8 @@ XTredeem_scroll_bar (struct window *window) bar->next = FRAME_SCROLL_BARS (f); bar->prev = Qnil; - XSETVECTOR (FRAME_SCROLL_BARS (f), bar); + XSETVECTOR (barobj, bar); + FSET (f, scroll_bars, barobj); if (! NILP (bar->next)) XSETVECTOR (XSCROLL_BAR (bar->next)->prev, bar); } @@ -5492,7 +5498,7 @@ XTjudge_scroll_bars (FRAME_PTR f) /* Clear out the condemned list now so we won't try to process any more events on the hapless scroll bars. */ - FRAME_CONDEMNED_SCROLL_BARS (f) = Qnil; + FSET (f, condemned_scroll_bars, Qnil); for (; ! NILP (bar); bar = next) { @@ -5619,7 +5625,7 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, XEvent *event, struct input_e static void x_scroll_bar_note_movement (struct scroll_bar *bar, XEvent *event) { - FRAME_PTR f = XFRAME (WVAR (XWINDOW (bar->window), frame)); + FRAME_PTR f = XFRAME (XWINDOW (bar->window)->frame); last_mouse_movement_time = event->xmotion.time; @@ -6366,7 +6372,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, mouse highlighting. */ if (!hlinfo->mouse_face_hidden && INTEGERP (Vmouse_highlight) && (f == 0 - || !EQ (FVAR (f, tool_bar_window), hlinfo->mouse_face_window))) + || !EQ (f->tool_bar_window, hlinfo->mouse_face_window))) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = 1; @@ -6793,8 +6799,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, create event iff we don't leave the selected frame. */ && (focus_follows_mouse - || (EQ (WVAR (XWINDOW (window), frame), - WVAR (XWINDOW (selected_window), frame))))) + || (EQ (XWINDOW (window)->frame, + XWINDOW (selected_window)->frame)))) { inev.ie.kind = SELECT_WINDOW_EVENT; inev.ie.frame_or_window = window; @@ -6913,15 +6919,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr, if (f) { /* Is this in the tool-bar? */ - if (WINDOWP (FVAR (f, tool_bar_window)) - && WINDOW_TOTAL_LINES (XWINDOW (FVAR (f, tool_bar_window)))) + if (WINDOWP (f->tool_bar_window) + && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window))) { Lisp_Object window; int x = event.xbutton.x; int y = event.xbutton.y; window = window_from_coordinates (f, x, y, 0, 1); - tool_bar_p = EQ (window, FVAR (f, tool_bar_window)); + tool_bar_p = EQ (window, f->tool_bar_window); if (tool_bar_p && event.xbutton.button < 4) { @@ -7343,7 +7349,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row) static void x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text_cursor_kinds kind) { - struct frame *f = XFRAME (WVAR (w, frame)); + struct frame *f = XFRAME (w->frame); struct glyph *cursor_glyph; /* If cursor is out of bounds, don't draw garbage. This can happen @@ -7517,7 +7523,7 @@ x_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, int } #ifdef HAVE_X_I18N - if (w == XWINDOW (FVAR (f, selected_window))) + if (w == XWINDOW (f->selected_window)) if (FRAME_XIC (f) && (FRAME_XIC_STYLE (f) & XIMPreeditPosition)) xic_set_preeditarea (w, x, y); #endif @@ -7843,7 +7849,7 @@ x_connection_closed (Display *dpy, const char *error_message) { /* Set this to t so that delete_frame won't get confused trying to find a replacement. */ - KVAR (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame) = Qt; + KSET (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame, Qt); delete_frame (frame, Qnoelisp); } @@ -8168,7 +8174,7 @@ xim_instantiate_callback (Display *display, XPointer client_data, XPointer call_ xic_set_statusarea (f); if (FRAME_XIC_STYLE (f) & XIMPreeditPosition) { - struct window *w = XWINDOW (FVAR (f, selected_window)); + struct window *w = XWINDOW (f->selected_window); xic_set_preeditarea (w, w->cursor.x, w->cursor.y); } } @@ -8956,7 +8962,7 @@ x_set_window_size (struct frame *f, int change_gravity, int cols, int rows) #endif /* not USE_GTK */ /* If cursor was outside the new size, mark it as off. */ - mark_window_cursors_off (XWINDOW (FVAR (f, root_window))); + mark_window_cursors_off (XWINDOW (f->root_window)); /* Clear out any recollection of where the mouse highlighting was, since it might be in a place that's outside the new frame size. @@ -10127,7 +10133,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { terminal->kboard = xmalloc (sizeof *terminal->kboard); init_kboard (terminal->kboard); - KVAR (terminal->kboard, Vwindow_system) = Qx; + KSET (terminal->kboard, Vwindow_system, Qx); /* Add the keyboard to the list before running Lisp code (via Qvendor_specific_keysyms below), since these are not traced @@ -10135,7 +10141,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; - if (!EQ (SVAR (XSYMBOL (Qvendor_specific_keysyms), function), Qunbound)) + if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound)) { char *vendor = ServerVendor (dpy); @@ -10149,9 +10155,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* Temporarily hide the partially initialized terminal. */ terminal_list = terminal->next_terminal; UNBLOCK_INPUT; - KVAR (terminal->kboard, Vsystem_key_alist) - = call1 (Qvendor_specific_keysyms, - vendor ? build_string (vendor) : empty_unibyte_string); + KSET (terminal->kboard, Vsystem_key_alist, + call1 (Qvendor_specific_keysyms, + vendor ? build_string (vendor) : empty_unibyte_string)); BLOCK_INPUT; terminal->next_terminal = terminal_list; terminal_list = terminal; diff --git a/test/ChangeLog b/test/ChangeLog index 03d43d72b54..f1bf458f812 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,7 +1,40 @@ +2012-08-14 Dmitry Gutov + + * indent/ruby.rb: Rearrange examples, add new ones. + +2012-08-12 Dmitry Gutov + + * automated/ruby-mode-tests.el (ruby-move-to-block-stops-at-opening) + (ruby-toggle-block-to-do-end, ruby-toggle-block-to-brace): New test. + +2012-08-11 Glenn Morris + + * automated/files.el: New file. + + * automated/Makefile.in (all): Fix typo. + +2012-08-10 Dmitry Gutov + + * automated/ruby-mode-tests.el (ruby-should-indent): + Add docstring, check (current-indentation) instead of (current-column). + (ruby-should-indent-buffer): New function. + Add tests for `ruby-deep-indent-paren' behavior. + Port all tests from test/misc/test_ruby_mode.rb in Ruby repo. + +2012-08-10 Nobuyoshi Nakada + + Original tests in test_ruby_mode.rb in upstream (author). + +2012-08-09 Dmitry Gutov + + * automated/ruby-mode-tests.el (ruby-should-indent) + (ruby-assert-state): New functions. + Add new tests. + 2012-07-29 David Engster - * automated/xml-parse-tests.el (xml-parse-tests--qnames): New - variable to hold test data for name expansion. + * automated/xml-parse-tests.el (xml-parse-tests--qnames): + New variable to hold test data for name expansion. (xml-parse-tests): Test the two different types of name expansion. 2012-07-29 Juri Linkov diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index 4f2e8a59e49..5f92e21d91a 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in @@ -55,7 +55,7 @@ setwins=subdirs=`find . -type d -print`; \ esac; \ done -all: test +all: check doit: diff --git a/test/automated/files.el b/test/automated/files.el new file mode 100644 index 00000000000..e43d8c32f85 --- /dev/null +++ b/test/automated/files.el @@ -0,0 +1,52 @@ +;;; files.el --- tests for file handling. + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Code: + +(require 'ert) + +(defvar files-test-var1 nil) + +(defun files-test-fun1 () + (setq files-test-var1 t)) + +(ert-deftest files-test-bug12155 () + "Test for http://debbugs.gnu.org/12155 ." + (with-temp-buffer + (insert "text\n" + ";; Local Variables:\n" + ";; eval: (files-test-fun1)\n" + ";; End:\n") + (let ((enable-local-variables :safe) + (enable-local-eval 'maybe)) + (hack-local-variables) + (should (eq files-test-var1 nil))))) + +(ert-deftest files-test-disable-local-variables () + "Test that setting enable-local-variables to nil works." + (with-temp-buffer + (insert "text\n" + ";; Local Variables:\n" + ";; files-test-var1: t\n" + ";; End:\n") + (let ((enable-local-variables nil)) + (hack-local-variables) + (should (eq files-test-var1 nil))))) + +;;; files.el ends here diff --git a/test/automated/ruby-mode-tests.el b/test/automated/ruby-mode-tests.el index 1a91f518b92..df51aa0d15a 100644 --- a/test/automated/ruby-mode-tests.el +++ b/test/automated/ruby-mode-tests.el @@ -23,16 +23,199 @@ (require 'ruby-mode) -(ert-deftest indent-line-after-symbol-made-from-string-interpolation () +(defun ruby-should-indent (content column) + "Assert indentation COLUMN on the last line of CONTENT." + (with-temp-buffer + (insert content) + (ruby-mode) + (ruby-indent-line) + (should (= (current-indentation) column)))) + +(defun ruby-should-indent-buffer (expected content) + "Assert that CONTENT turns into EXPECTED after the buffer is re-indented. + +The whitespace before and including \"|\" on each line is removed." + (with-temp-buffer + (cl-flet ((fix-indent (s) (replace-regexp-in-string "^[ \t]*|" "" s))) + (insert (fix-indent content)) + (ruby-mode) + (indent-region (point-min) (point-max)) + (should (string= (fix-indent expected) (buffer-substring-no-properties + (point-min) (point-max))))))) + +(defun ruby-assert-state (content &rest values-plist) + "Assert syntax state values at the end of CONTENT. + +VALUES-PLIST is a list with alternating index and value elements." + (with-temp-buffer + (insert content) + (ruby-mode) + (syntax-propertize (point)) + (while values-plist + (should (eq (nth (car values-plist) + (parse-partial-sexp (point-min) (point))) + (cadr values-plist))) + (setq values-plist (cddr values-plist))))) + +(ert-deftest ruby-indent-after-symbol-made-from-string-interpolation () "It can indent the line after symbol made using string interpolation." - (let ((initial-content "def foo(suffix)\n :\"bar#{suffix}\"\n") - (expected-content "def foo(suffix)\n :\"bar#{suffix}\"\n ")) - (with-temp-buffer - (insert initial-content) - (ruby-indent-line) ; Doesn't rely on text properties or the syntax table. - (let ((buffer-content (buffer-substring-no-properties (point-min) - (point-max)))) - (should (string= buffer-content expected-content)))))) + (ruby-should-indent "def foo(suffix)\n :\"bar#{suffix}\"\n" + ruby-indent-level)) + +(ert-deftest ruby-indent-after-js-style-symbol-with-block-beg-name () + "JS-style hash symbol can have keyword name." + (ruby-should-indent "link_to \"home\", home_path, class: \"foo\"\n" 0)) + +(ert-deftest ruby-discern-singleton-class-from-heredoc () + (ruby-assert-state "foo <